Squeak 4.6: WebClient-HTTP-topa.2.mcz

Chris Muller uploaded a new version of WebClient-HTTP to project Squeak 4.6:
http://source.squeak.org/squeak46/WebClient-HTTP-topa.2.mcz

==================== Summary ====================

Name: WebClient-HTTP-topa.2
Author: topa
Time: 20 April 2015, 2:36:49.456 pm
UUID: c28c613c-a2f9-443b-a431-191aff2b96ca
Ancestors: WebClient-HTTP-ar.1

Fix for missing CrLf global

==================== Snapshot ====================

----- Method: HTTPSocket class>>httpGet:args:user:passwd: (in category '*WebClient-HTTP-override') -----
httpGet: url args: args user: user passwd: passwd
        "Upload the contents of the stream to a file on the server.

        WARNING: This method will send a basic auth header proactively.
        This is necessary to avoid breaking MC and SqueakSource since SS does not
        return a 401 when accessing a private (global no access) repository."

        | urlString xhdrs client resp progress |

        "Normalize the url"
        urlString := (Url absoluteFromText: url) asString.

        "Some raw extra headers which historically have been added"
        xhdrs := HTTPProxyCredentials,
                HTTPBlabEmail. "may be empty"

        client := WebClient new.
        client username: user; password: passwd.
        ^[resp := client httpGet: urlString do:[:req|
       
                "HACK: Proactively send a basic auth header.
                See comment above."
                req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded.

                "Accept anything"
                req addHeader: 'Accept' value: '*/*'.
                "Add the additional headers"
                (WebUtils readHeadersFrom: xhdrs readStream)
                        do:[:assoc| req addHeader: assoc key value: assoc value]].

        progress := [:total :amount|
                (HTTPProgress new) total: total; amount: amount; signal: 'Downloading...'
        ].

        "Simulate old HTTPSocket return behavior"
        (resp code between: 200 and: 299)
                ifTrue:[^(RWBinaryOrTextStream with: (resp contentWithProgress: progress)) reset]
                ifFalse:[resp asString, resp content].
        ] ensure:[client destroy].
!

----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category '*WebClient-HTTP-override') -----
httpGetDocument: url args: args accept: mimeType request: requestString
        "Return the exact contents of a web object. Asks for the given MIME type. If mimeType is nil, use 'text/html'. An extra requestString may be submitted and must end with crlf.  The parsed header is saved. Use a proxy server if one has been registered.  tk 7/23/97 17:12"

        "Note: To fetch raw data, you can use the MIME type 'application/octet-stream'."

        | client xhdrs resp urlString progress |
        "Normalize the url"
        urlString := (Url absoluteFromText: url) asString.

        args ifNotNil: [
                urlString := urlString, (self argString: args)
        ].

        "Some raw extra headers which historically have been added"
        xhdrs := HTTPProxyCredentials,
                HTTPBlabEmail, "may be empty"
                requestString. "extra user request. Authorization"

        client := WebClient new.
        ^[resp := client httpGet: urlString do:[:req|
                "Add ACCEPT header"
                mimeType ifNotNil:[req headerAt: 'Accept' put: mimeType].

                "Always accept plain text"
                req addHeader: 'Accept' value: 'text/html'.

                "Add the additional headers"
                (WebUtils readHeadersFrom: xhdrs readStream)
                        do:[:assoc| req addHeader: assoc key value: assoc value]].

        progress := [:total :amount|
                (HTTPProgress new) total: total; amount: amount; signal: 'Downloading...'
        ].

        "Simulate old HTTPSocket return behavior"
        (resp code between: 200 and: 299)
                ifTrue:[MIMEDocument contentType: resp contentType
                                content: (resp contentWithProgress: progress) url: url]
                ifFalse:[resp asString, resp content].
        ] ensure:[client destroy].
!

----- Method: HTTPSocket class>>httpPost:args:user:passwd: (in category '*WebClient-HTTP-override') -----
httpPost: url args: args user: user passwd: passwd

        "WARNING: This method will send a basic auth header proactively.
        This is necessary to avoid breaking MC and SqueakSource since SS does not
        return a 401 when accessing a private (global no access) repository."

        | argString xhdrs client resp urlString |
        "Normalize the url"
        urlString := (Url absoluteFromText: url) asString.

        args ifNotNil: [
                argString := self argString: args.
                argString first = $? ifTrue: [argString := argString allButFirst].
        ].

        "Some raw extra headers which historically have been added"
        xhdrs := HTTPProxyCredentials,
                HTTPBlabEmail. "may be empty"

        client := WebClient new.
        client username: (user ifEmpty:[nil]); password: (passwd ifEmpty:[nil]).
        ^[resp := client httpPost: urlString content: (argString ifNil:[''])
                                type: 'application/x-www-form-urlencoded'  do:[:req|
                "HACK: Proactively send a basic auth header.
                See comment above."
                req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded.
                "Accept anything"
                req addHeader: 'Accept' value: '*/*'.
                "Add the additional headers"
                (WebUtils readHeadersFrom: xhdrs readStream)
                        do:[:assoc| req addHeader: assoc key value: assoc value]].

        "Simulate old HTTPSocket return behavior"
        (resp code between: 200 and: 299)
                ifTrue:[MIMEDocument
                                        contentType: resp contentType content: resp content url: url]
                ifFalse:[resp asString, resp content].
        ] ensure:[client destroy].
!

----- Method: HTTPSocket class>>httpPost:content:type:accept:request: (in category '*WebClient-HTTP-override') -----
httpPost: url content: postData type: contentType accept: mimeType request: requestString
        "like httpGET, except it does a POST instead of a GET.  POST allows data to be uploaded"

        | urlString xhdrs client resp |
        "Normalize the url"
        urlString := (Url absoluteFromText: url) asString.

        "Some raw extra headers which historically have been added"
        xhdrs := HTTPProxyCredentials,
                HTTPBlabEmail, "may be empty"
                requestString. "extra user request. Authorization"
        client := WebClient new.
        ^[resp := client httpPost: urlString content: (postData ifNil:[''])
                                type: contentType do:[:req|
                "Add ACCEPT header"
                mimeType ifNotNil:[req headerAt: 'Accept' put: mimeType].

                "Always accept plain text"
                req addHeader: 'Accept' value: 'text/html'.

                "Add the additional headers"
                (WebUtils readHeadersFrom: xhdrs readStream)
                        do:[:assoc| req addHeader: assoc key value: assoc value]].

        "Simulate old HTTPSocket return behavior"
        (resp code between: 200 and: 299)
                ifTrue:[MIMEDocument
                                        contentType: resp contentType content: resp content url: url]
                ifFalse:[resp asString, resp content].
        ] ensure:[client destroy].
!

----- Method: HTTPSocket class>>httpPostDocument:args:accept:request: (in category '*WebClient-HTTP-override') -----
httpPostDocument: url  args: args accept: mimeType request: requestString
        "like httpGET, except it does a POST instead of a GET.  POST allows data to be uploaded"

        | argString  |
        args ifNotNil: [
                argString := self argString: args.
                argString first = $? ifTrue: [argString := argString allButFirst].
        ].

        ^self httpPost: url
                        content: argString
                        type: 'application/x-www-form-urlencoded'
                        accept: mimeType
                        request: requestString!

----- Method: HTTPSocket class>>httpPostMultipart:args:accept:request: (in category '*WebClient-HTTP-override') -----
httpPostMultipart: url args: argsDict accept: mimeType request: requestString
        " do multipart/form-data encoding rather than x-www-urlencoded "

        | mimeBorder argsStream |
        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 | | fieldValue |
                "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="'; nextPutAll: value url pathForFile; nextPut: $"; crlf;
                                        nextPutAll: 'Content-Type: '; nextPutAll: value contentType.
                                fieldValue := (value content
                                        ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile]
                                        ifNotNil: [value content]) asString].
" Transcript show: 'field=', key, '; value=', fieldValue; cr. "
                argsStream crlf; crlf; nextPutAll: fieldValue; crlf
        ]].
        argsStream nextPutAll: '--', mimeBorder, '--'.

        ^self httpPost: url
                        content: argsStream contents
                        type:  'multipart/form-data; boundary=', mimeBorder
                        accept: mimeType
                        request: requestString
!

----- Method: HTTPSocket class>>httpPostToSuperSwiki:args:accept:request: (in category '*WebClient-HTTP-override') -----
httpPostToSuperSwiki: url args: argsDict accept: mimeType request: requestString

        | mimeBorder argString |
        mimeBorder := '---------SuperSwiki',Time millisecondClockValue printString,'-----'.
        argString := String streamContents: [ :strm |
                strm nextPutAll: mimeBorder; crlf.
                argsDict associationsDo: [:assoc |
                        assoc value do: [ :value |
                                strm
                                        nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'; crlf; crlf;
                                        nextPutAll: value; crlf; crlf;
                                        nextPutAll: mimeBorder; crlf.
                        ]
                ].
        ].

        ^self httpPost: url
                        content: argString
                        type:  'multipart/form-data; boundary=', mimeBorder
                        accept: mimeType
                        request: requestString
!

----- Method: HTTPSocket class>>httpPut:to:user:passwd: (in category '*WebClient-HTTP-override') -----
httpPut: contents to: url user: user passwd: passwd
        "Upload the contents of the stream to a file on the server
       
        WARNING: This method will send a basic auth header proactively.
        This is necessary to avoid breaking MC and SqueakSource since SS does not
        return a 401 when accessing a private (global no access) repository."

        | urlString xhdrs client resp |

        "Normalize the url"
        urlString := (Url absoluteFromText: url) asString.

        "Some raw extra headers which historically have been added"
        xhdrs := HTTPProxyCredentials,
                HTTPBlabEmail. "may be empty"

        client := WebClient new.
        client username: (user ifEmpty:[nil]); password: (passwd ifEmpty:[nil]).
        ^[resp := client httpPut: urlString content: contents type: nil  do:[:req|
                "HACK: Proactively send a basic auth header.
                See comment above."
                req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded.
                "Accept anything"
                req addHeader: 'Accept' value: '*/*'.
                "Add the additional headers"
                (WebUtils readHeadersFrom: xhdrs readStream)
                        do:[:assoc| req addHeader: assoc key value: assoc value]].

        "Simulate old HTTPSocket return behavior"
        resp asString, resp content
        ] ensure:[client destroy].
!