'From Pharo1.2a of ''11 June 2010'' [Latest update: #12107] on 31 August 2010 at 9:03:53 pm'!

!MIMEDocument methodsFor: 'accessing' stamp: 'asasa 8/31/2010 20:40'!
url
	"Answer the URL the receiver was downloaded from.  It may legitimately be nil."

	^ uri ifNotNil:[uri asString asUrl]!
]style[(3 119)f2cblack;b,f2cblack;! !


!HTTPSocket methodsFor: 'receiving' stamp: 'asasa 8/31/2010 20:41'!
getResponseUpTo: markerString
	"Keep reading until the marker is seen.  Return three parts: header, marker, beginningOfData.  Fails if no marker in first 2000 chars." 

	| buf position bytesRead tester mm tries |
	buf := String new: 2000.
	position := 0.
	tester := 1. mm := 1.
	tries := 3.
	[tester := tester - markerString size + 1 max: 1.  "rewind a little, in case the marker crosses a read boundary"
	tester to: position do: [:tt |
		(buf at: tt) = (markerString at: mm) ifTrue: [mm := mm + 1] ifFalse: [mm := 1].
			"Not totally correct for markers like xx0xx"
		mm > markerString size ifTrue: ["got it"
			^ Array with: (buf copyFrom: 1 to: tt+1-mm)
				with: markerString
				with: (buf copyFrom: tt+1 to: position)]].
	 tester := 1 max: position.	"OK if mm in the middle"
	 (position < buf size) & (self isConnected | self dataAvailable) 
			& ((tries := tries - 1) >= 0)] whileTrue: [
		self waitForDataFor: 5 ifClosed: [
				Transcript show: ' <connection closed> ']
			ifTimedOut: [
				Transcript show: ' <response was late> '].
		bytesRead := self primSocket: socketHandle receiveDataInto: buf 
			startingAt: position + 1 count: buf size - position.
		position := position + bytesRead].

	^ Array with: (buf copyFrom: 1 to: position)
		with: ''
		with: ''		"Marker not found and connection closed".
!
]style[(29 1285)f2cblack;b,f2cblack;! !


!HTTPSocket class methodsFor: 'get the page' stamp: 'asasa 8/31/2010 20:59'!
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 |
	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 := self httpProxyServer.
		port := self httpProxyPort].

	mimeBorder := '----squeak-georgia-tech-', Time millisecondClockValue printString, '-csl-cool-stuff-----'.
	"encode the arguments dictionary"
	argsStream := String new writeStream.
	argsDict associationsDo: [:assoc |
		assoc value do: [ :value | | fieldValue |
		"print the boundary"
		argsStream nextPutAll: '--', mimeBorder, String 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, '"', String 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: String crlf, String crlf, fieldValue, String 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 waitForConnectionFor: self standardTimeout.
	Transcript cr; show: serverName, ':', port asString; cr.
	s sendCommand: 'POST ', page, ' HTTP/1.1', String crlf, 
		(mimeType ifNotNil: ['ACCEPT: ', mimeType, String crlf] ifNil: ['']),
		'ACCEPT: text/html', String crlf,	"Always accept plain text"
		HTTPProxyCredentials,
		HTTPBlabEmail,	"may be empty"
		requestString,	"extra user request. Authorization"
		self userAgentString, String crlf,
		'Content-type: multipart/form-data; boundary=', mimeBorder, String crlf,
		'Content-length: ', argsStream contents size printString, String crlf,
		'Connection: close', String crlf,
		'Host: ', specifiedServer, String crlf.  "blank line automatically added"

	s sendCommand: argsStream contents.

	"get the header of the reply"
	list := s getResponseUpTo: String crlf, String 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!
]style[(77 4412)f2cblack;b,f2cblack;! !