REBOL [
    Title: "Http tools"
    Date: 14-Dec-2000
    Version: 0.0.3
    File: %http-tools.r
    Author: "Graham Chiu"
    Usage: {

^-^-variables are stored in the http-tools-data object. To read a page which requires

^-^-basic http-authentication, set them first as follows:



^-^-http-tools-data/username: "myusername"

^-^-http-tools-data/password: "mypassword"



^-^-You may clear them by using the function 'clear-http-tools



^-^-To fetch a page which sends you a cookie, pass the function an empty block



^-^-tmp: HTTP-TOOLS http://www.rebol.com []



^-^-The url encoded cookie will be returned as http-tools-data/cookie-data



^-^-To post to a page which may or may not require a cookie, pass the name value pairs in the block,

^-^-and call 'http-tools with the /post refinement.



^-^-tmp: HTTP-TOOLS/POST http://www.rebol.com/cgi-bin/register.r [ "name1" "value1" "name2" value2" ... ]



^-^-http-tools will use the cookie(s) stored in http-tools-data/cookie-data

^-^-The name value pairs will be url-encoded by http-tools.



^-^-The page in all cases will be returned by the function.  You can view the content

^-^-as tmp/content, and look at the header data by



^-^-probe tmp



^-^-If the page fetched by http-tools contains a location directive, that will be

^-^-also stored in http-tools-data/location



^-}
    Purpose: {To grab cookies from the server and post form data.

}
    Email: gchiu@compkarori.co.nz
    Notes: {

^-^-Modification of Andrew Grossman's cookies-client script by Graham Chiu. 

^-^-Modification of Martin Johannesson's POST script by Andrew Grossman.

^-^-Orig. cookies-client.r available at www.rebol.com in users' library.

^-}
    library: [
        level: 'advanced 
        platform: none 
        type: 'tool 
        domain: 'web 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]



url-encode: func [

    {URL-encode a string}

    data "String to encode"

    /local new-data

][

    new-data: make string! ""

    normal-char: charset [

        #"A" - #"Z" #"a" - #"z"

        #"@" #"." #"*" #"-" #"_"

        #"0" - #"9"

    ]

    if not string? data [return new-data]

    forall data [

        append new-data either find normal-char first data [

            first data

        ][

            rejoin ["%" to-string skip tail (to-hex to-integer first data) -2]

        ]

    ]

    new-data

]



http-tools-data: make object! [

    location: copy ""

    username: copy ""

    password: copy ""

    cookie-data: copy ""

]



http-tools: func [

    { read pages off web server, or post values to http forms and automatically handle cookies, authentication }

    url "The URL"

    data [block!] "A block of name/value pairs to represent the form data"

    /local

    encoded-data

    port-spec

    HTTP-Post-Header

    http-request

    buffer

    tmp-buffer

    tmp-header

    /post "Post form data"

] [



    port-spec: make port! [

        scheme: 'tcp

        port-id: 80

        timeout: 0:30

    ]



    ; check that being passed a valid url

    net-utils/url-parser/parse-url port-spec url



    ; encode the value pairs 

    encoded-data: make string! ""

    foreach [name value] data [

        append encoded-data rejoin [

            url-encode name "=" url-encode value "&"

        ]

    ]



    remove back tail encoded-data



    either post

    [; post data to a form  at url



        HTTP-Post-Header: make object! [

            Accept: "text/html"

            User-Agent: reform ["REBOL" system/version]

            Host: port-spec/host

            Content-Type: "application/x-www-form-urlencoded"

            Content-Length: length? encoded-data

            Cookie: http-tools-data/cookie-data

            Authorization: join {Basic } enbase rejoin [http-tools-data/username ":" http-tools-data/password]

        ]



        http-request: rejoin [

            "POST /"

            either found? port-spec/path [port-spec/path] [""]

            either found? port-spec/target [port-spec/target] [""]

            " HTTP/1.0"

        ]

    ]



    [; just read the url

        HTTP-Post-Header: make object! [

            Accept: "*/*"

            User-Agent: reform ["REBOL" system/version]

            Host: port-spec/host

            Cookie: http-tools-data/cookie-data

            Authorization: join {Basic } enbase rejoin [http-tools-data/username ":" http-tools-data/password]

        ]



        http-request: rejoin [

            "GET /"

            either found? port-spec/path [port-spec/path] [""]

            either found? port-spec/target [port-spec/target] [""]

            " HTTP/1.0"

        ]

    ]



    http-port-private: open/lines [

        scheme: 'tcp

        port-id: port-spec/port-id

        timeout: port-spec/timeout

        host: port-spec/host

        user: port-spec/user

        pass: port-spec/pass

    ]



    insert http-port-private http-request

    insert http-port-private net-utils/export HTTP-Post-Header "^/"

    if not empty? encoded-data [

        insert http-port-private encoded-data

    ]



    buffer: make string! 10000

    tmp-buffer: reform ["HTTP-Response:" pick http-port-private 1]

    while [not none? tmp-buffer] [

        append buffer rejoin [tmp-buffer "^/"]

        tmp-buffer: pick http-port-private 1

    ]



    close http-port-private



    http-tools-data/cookie-data: copy ""

    parse buffer [ any [thru "Set-cookie:" copy txt to " " (append http-tools-data/cookie-data txt) ] | skip ]



    HTTP-Header: make object! [

        HTTP-Response: Date: Server: Last-Modified: none

        Accept-Ranges: Content-Encoding: Content-Type: none

        Content-Length: Location: Expires: Referer: Connection: none

        Set-Cookie: none

    ]



    tmp-header: parse-header HTTP-Header buffer



    either none? tmp-header/Location 

    [   http-tools-data/location: copy "" ]

    [   http-tools-data/location: tmp-header/Location   ]

    tmp-header

]



clear-http-tools: func [] [

    http-tools-data/cookie-data: copy ""

    http-tools-data/location: copy ""

    http-tools-data/username: copy ""

    http-tools-data/password: copy ""

]