'From Squeak3.7alpha of 11 September 2003 [latest update: #5707] on 28 February 2004 at 6:59:43 pm'! !HTTPSocket class methodsFor: 'get the page' stamp: 'daf 2/28/2004 18:56'! httpPostDocument: url args: argsDict accept: mimeType request: requestString "like httpGET, except it does a POST instead of a GET. POST allows data to be uploaded" | s header length page list firstData aStream type newUrl httpUrl argString | Socket initializeNetwork. httpUrl _ Url absoluteFromText: url. page _ httpUrl fullPath. "add arguments" argString _ argsDict ifNotNil: [argString _ self argString: argsDict] ifNil: ['']. page _ page, argString. s _ HTTPSocket new. s _ self initHTTPSocket: httpUrl wait: (self deadlineSecs: 30) ifError: [:errorString | ^errorString]. s sendCommand: 'POST ', page, ' HTTP/1.0', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Content-type: application/x-www-form-urlencoded', CrLf, 'Content-length: ', argString size printString, CrLf, 'Host: ', httpUrl authority, CrLf. "blank line automatically added" argString first = $? ifTrue: [ argString _ argString copyFrom: 2 to: argString size]. "umur - IE sends argString without a $? and swiki expects so" s sendCommand: argString. "get the header of the reply" list _ s getResponseUpTo: CrLf, CrLf ignoring: (String with: CR). "list = header, CrLf, CrLf, beginningOfData" header _ list at: 1. "Transcript show: page; cr; show: argsStream contents; cr; show: header; cr." firstData _ list at: 3. "dig out some headers" s header: header. length _ s getHeader: 'content-length'. length ifNotNil: [ length _ length asNumber ]. type _ s getHeader: 'content-type'. s responseCode first = $3 ifTrue: [ newUrl _ s getHeader: 'location'. newUrl ifNotNil: [ "umur 6/25/2003 12:58 - If newUrl is relative then we need to make it absolute." newUrl _ (httpUrl newFromRelativeText: newUrl) asString. self flag: #refactor. "get, post, postmultipart are almost doing the same stuff" s destroy. "^self httpPostDocument: newUrl args: argsDict accept: mimeType" ^self httpGetDocument: newUrl accept: mimeType ] ]. aStream _ s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!" ^ MIMEDocument contentType: type content: aStream contents url: url! ]style[(77 693 21 303 150 561 228 369)f1b,f1,f2,f1,f1cmagenta;,f1,f1cmagenta;,f1! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'daf 2/28/2004 18:58'! httpPostMultipart: url args: argsDict accept: mimeType request: requestString " do multipart/form-data encoding rather than x-www-urlencoded " " by Bolot Kerimbaev, 1998 " " this version is a memory hog: puts the whole file in memory " "bolot 12/14/2000 18:28 -- minor fixes to make it comply with RFC 1867" | serverName serverAddr s header length bare page list firstData aStream port argsStream specifiedServer type newUrl mimeBorder fieldValue | Socket initializeNetwork. "parse url" bare _ (url asLowercase beginsWith: 'http://') ifTrue: [url copyFrom: 8 to: url size] ifFalse: [url]. serverName _ bare copyUpTo: $/. specifiedServer _ serverName. (serverName includes: $:) ifFalse: [ port _ self defaultPort ] ifTrue: [ port _ (serverName copyFrom: (serverName indexOf: $:) + 1 to: serverName size) asNumber. serverName _ serverName copyUpTo: $:. ]. page _ bare copyFrom: (bare indexOf: $/) to: bare size. page size = 0 ifTrue: [page _ '/']. (self shouldUseProxy: serverName) ifTrue: [ page _ 'http://', serverName, ':', port printString, page. "put back together" serverName _ HTTPProxyServer. port _ HTTPProxyPort]. mimeBorder _ '----squeak-georgia-tech-', Time millisecondClockValue printString, '-csl-cool-stuff-----'. "encode the arguments dictionary" argsStream _ WriteStream on: String new. argsDict associationsDo: [:assoc | assoc value do: [ :value | "print the boundary" argsStream nextPutAll: '--', mimeBorder, CrLf. " check if it's a non-text field " argsStream nextPutAll: 'Content-disposition: multipart/form-data; name="', assoc key, '"'. (value isKindOf: MIMEDocument) ifFalse: [fieldValue _ value] ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', CrLf, 'Content-Type: ', value contentType. fieldValue _ (value content ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile] ifNotNil: [value content]) asString]. " Transcript show: 'field=', key, '; value=', fieldValue; cr. " argsStream nextPutAll: CrLf, CrLf, fieldValue, CrLf. ]]. argsStream nextPutAll: '--', mimeBorder, '--'. "make the request" serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName]. s _ HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. Transcript cr; show: serverName, ':', port asString; cr. s sendCommand: 'POST ', page, ' HTTP/1.1', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Content-type: multipart/form-data; boundary=', mimeBorder, CrLf, 'Content-length: ', argsStream contents size printString, CrLf, 'Host: ', specifiedServer, CrLf. "blank line automatically added" s sendCommand: argsStream contents. "get the header of the reply" list _ s getResponseUpTo: CrLf, CrLf. "list = header, CrLf, CrLf, beginningOfData" header _ list at: 1. "Transcript show: page; cr; show: argsStream contents; cr; show: header; cr." firstData _ list at: 3. "dig out some headers" s header: header. length _ s getHeader: 'content-length'. length ifNotNil: [ length _ length asNumber ]. type _ s getHeader: 'content-type'. s responseCode first = $3 ifTrue: [ "redirected - don't re-post automatically" "for now, just do a GET, without discriminating between 301/302 codes" newUrl _ s getHeader: 'location'. newUrl ifNotNil: [ (newUrl beginsWith: 'http://') ifFalse: [ (newUrl beginsWith: '/') ifTrue: [newUrl _ (bare copyUpTo: $/), newUrl] ifFalse: [newUrl _ url, newUrl. self flag: #todo "should do a relative URL"] ]. Transcript show: 'redirecting to: ', newUrl; cr. s destroy. ^self httpGetDocument: newUrl "for some codes, may do: ^self httpPostMultipart: newUrl args: argsDict accept: mimeType request: requestString"] ]. aStream _ s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!" ^ MIMEDocument contentType: type content: aStream contents url: url! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'daf 2/28/2004 18:58'! httpPostToSuperSwiki: url args: argsDict accept: mimeType request: requestString | serverName serverAddr s header length bare page list firstData aStream port specifiedServer type mimeBorder contentsData | Socket initializeNetwork. "parse url" bare _ (url asLowercase beginsWith: 'http://') ifTrue: [url copyFrom: 8 to: url size] ifFalse: [url]. serverName _ bare copyUpTo: $/. specifiedServer _ serverName. (serverName includes: $:) ifFalse: [ port _ self defaultPort ] ifTrue: [ port _ (serverName copyFrom: (serverName indexOf: $:) + 1 to: serverName size) asNumber. serverName _ serverName copyUpTo: $:. ]. page _ bare copyFrom: (bare indexOf: $/ ifAbsent: [^'error']) to: bare size. page size = 0 ifTrue: [page _ '/']. (self shouldUseProxy: serverName) ifTrue: [ page _ 'http://', serverName, ':', port printString, page. "put back together" serverName _ HTTPProxyServer. port _ HTTPProxyPort]. mimeBorder _ '---------SuperSwiki',Time millisecondClockValue printString,'-----'. contentsData _ String streamContents: [ :strm | strm nextPutAll: mimeBorder, CrLf. argsDict associationsDo: [:assoc | assoc value do: [ :value | strm nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'; nextPutAll: CrLf; nextPutAll: CrLf; nextPutAll: value; nextPutAll: CrLf; nextPutAll: CrLf; nextPutAll: mimeBorder; nextPutAll: CrLf. ] ]. ]. "make the request" serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName]. s _ HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. s sendCommand: 'POST ', page, ' HTTP/1.1', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Content-type: multipart/form-data; boundary=', mimeBorder, CrLf, 'Content-length: ', contentsData size printString, CrLf, 'Host: ', specifiedServer, CrLf. "blank line automatically added" s sendCommand: contentsData. list _ s getResponseUpTo: CrLf, CrLf. "list = header, CrLf, CrLf, beginningOfData" header _ list at: 1. firstData _ list at: 3. header isEmpty ifTrue: [ s destroy. ^'no response' ]. s header: header. length _ s getHeader: 'content-length'. length ifNotNil: [ length _ length asNumber ]. type _ s getHeader: 'content-type'. aStream _ s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!" ^ MIMEDocument contentType: type content: aStream contents url: url! !