Script Library: 1198 scripts
 

my-http.r

REBOL [ Title: "patched HTTP/HTTPS protocol with cookies support" Author: %cyphre--seznam--cz Company: "Prolific Publishing, Inc." Date: 18-Aug-2006 File: %my-http.r Purpose: "Provide an HTTP/HTTPS handler that transparently supports cookies" Library: [ level: 'advanced platform: 'windows 'linux type: [module tool] domain: [http protocol web] tested-under: [Command 2.5.6 Command 2.5.125 WindowsXP Linux] license: 'MIT support: none see-also: none ] ] cookies-db: copy [] cookie-object: make object! [ domain: path: name: value: expires: none ] get-cookies: func [port /local result domain path found?][ result: copy "Cookie: " ; print "GET COOKIES" domain: join "." port/host path: any [join "/" port/path ""] foreach c cookies-db [ if all [ find/part/reverse tail domain c/domain length? c/domain find/part path dirize c/path 1 + length? c/path ][ found?: true insert tail result rejoin [c/name "=" c/value "; "] ] ] remove/part back back tail result 2 insert tail result newline either found? [result][""] ] set-cookies-http: func [ port /direct cookie /local result digits chars found? c make-cookie ][ ; print "SET COOKIES" digits: charset [#"0" - #"9"] chars: charset [#"A" - #"Z" #"a" - #"z"] make-cookie: func [ c ][ result: make cookie-object [ domain: either port [join "." port/host][""] path: "/" expires: now + 365 ] insert tail c ";" parse c [ some [ copy name to "=" skip copy value to ";" skip ( switch/default name [ "expires" [ parse/all value [ some [ mark: 2 digits [" " | "-"] 3 chars [" " | "-"] 4 digits " " 2 digits ":" 2 digits ":" 2 digits ( mark/3: #"-" mark/7: #"-" mark/12: #"/" result/expires: (to-date copy/part mark 20) + now/zone ) | skip ] ] ] "path" [result/path: value] "domain" [result/domain: value] "version" [] "HTTPOnly" [] "secure" [] ][result/name: name result/value: value] ) | skip ] ] if all [series? result/path not empty? result/path][ found?: false foreach c cookies-db [ if all [ c/domain = result/domain c/path = result/path c/name = result/name found?: true (difference result/expires c/expires) > 0:00 ][ c/expires: result/expires c/value: result/value break ] ] if not found? [ insert tail cookies-db result ] ] ] either port [ foreach [n v] header-rules/head-list [ if n = to-set-word 'set-cookie [ if string? v [ make-cookie v ] if block? v [ foreach c v [ make-cookie c ] ] ] ] ][ make-cookie cookie ] remove-each c cookies-db ["EXPIRED" = c/value] ] system/schemes/http/user-agent: "Mozilla/5.0 (Windows; U; Windows NT 5.1; cs; rv:1.8.0.1) Gecko/20060111 Firefox/1.5.0.1" system/schemes/http/handler: make system/schemes/http/handler [ crlf-mode?: false open: func [ port "the port to open" /local http-packet http-command response-actions success error response-line target headers http-version post-data result generic-proxy? sub-protocol build-port send-and-check create-request line continue-post tunnel-actions tunnel-success response-code forward proxyauth ][ port/locals: make object! [list: copy [] headers: none] generic-proxy?: all [port/proxy/type = 'generic not none? port/proxy/host] build-port: func [] [ sub-protocol: either port/scheme = 'https ['ssl] ['tcp] open-proto/sub-protocol/generic port sub-protocol port/url: rejoin [lowercase to-string port/scheme "://" port/host either port/port-id <> 80 [join #":" port/port-id] [copy ""] slash] if found? port/path [append port/url port/path] if found? port/target [append port/url port/target] if sub-protocol = 'ssl [ if generic-proxy? [ HTTP-Get-Header: make object! [ Host: join port/host any [all [port/port-id (port/port-id <> 80) join #":" port/port-id] #] ] user: get in port/proxy 'user pass: get in port/proxy 'pass if string? :user [ HTTP-Get-Header: make HTTP-Get-Header [ Proxy-Authorization: join "Basic " enbase join user [#":" pass] ] ] http-packet: reform ["CONNECT" HTTP-Get-Header/Host "HTTP/1.1^/"] append http-packet net-utils/export HTTP-Get-Header append http-packet "^/" net-utils/net-log http-packet insert port/sub-port http-packet continue-post/tunnel ] system/words/set-modes port/sub-port [secure: true] ] ] ; smarter query http-command: either querying ["HEAD"] ["GET"] create-request: func [/local target user pass u] [ HTTP-Get-Header: make object! [ Accept: "*/*" Connection: "close" User-Agent: get in get in system/schemes port/scheme 'user-agent Host: join port/host any [all [port/port-id (port/port-id <> 80) join #":" port/port-id] #] ] if all [block? port/state/custom post-data: select port/state/custom 'header block? post-data] [ HTTP-Get-Header: make HTTP-Get-Header post-data ] HTTP-Header: make object! [ Date: Server: Last-Modified: Accept-Ranges: Content-Encoding: Content-Type: Content-Length: Location: Expires: Referer: Connection: Authorization: none ] http-version: "HTTP/1.0^/" all [port/user port/pass HTTP-Get-Header: make HTTP-Get-Header [Authorization: join "Basic " enbase join port/user [#":" port/pass]]] user: get in port/proxy 'user pass: get in port/proxy 'pass if all [generic-proxy? string? :user] [ HTTP-Get-Header: make HTTP-Get-Header [ Proxy-Authorization: join "Basic " enbase join user [#":" pass] ] ] if port/state/index > 0 [ http-version: "HTTP/1.1^/" HTTP-Get-Header: make HTTP-Get-Header [ Range: rejoin ["bytes=" port/state/index "-"] ] ] target: next mold to-file join (join "/" either found? port/path [port/path] [""]) either found? port/target [port/target] [""] post-data: none if all [block? port/state/custom post-data: find port/state/custom 'post post-data/2] [ http-command: "POST" HTTP-Get-Header: make HTTP-Get-Header append [ Referer: either find port/url #"?" [head clear find copy port/url #"?"] [port/url] Content-Type: "application/x-www-form-urlencoded" Content-Length: length? post-data/2 ] either block? post-data/3 [post-data/3] [[]] post-data: post-data/2 ] http-packet: reform [http-command either generic-proxy? [port/url] [target] http-version] append http-packet net-utils/export HTTP-Get-Header append http-packet get-cookies port if all [crlf-mode? port/scheme = 'https][ append http-packet "^/" replace/all http-packet lf crlf ] http-packet ] send-and-check: func [] [ net-utils/net-log http-packet insert port/sub-port http-packet if post-data [write-io port/sub-port post-data length? post-data] continue-post ] continue-post: func [/tunnel /local digit space] [ response-line: system/words/pick port/sub-port 1 net-utils/net-log response-line either none? response-line [do error] [ ; fixes #3494: should accept an HTTP/0.9 simple response. digit: charset "1234567890" space: charset " ^-" either parse/all response-line [ ; relaxing rule a bit ;"HTTP/" digit "." digit some space copy response-code 3 digit some space to end "HTTP/" digit "." digit some space copy response-code 3 digit to end ] [ ; valid status line response-code: to integer! response-code result: select either tunnel [tunnel-actions] [response-actions] response-code either none? result [do error] [do get result] ] [ ; could not parse status line, assuming HTTP/0.9 port/status: 'file ] ] ] tunnel-actions: [ 200 tunnel-success ] response-actions: [ 100 continue-post 200 success 201 success 204 success 206 success 300 forward 301 forward 302 forward 304 success 407 proxyauth ] tunnel-success: [ while [ ( line: pick port/sub-port 1 ) <> ""] [net-log line] ] success: [ headers: make string! 500 while [(line: pick port/sub-port 1) <> ""] [append headers join line "^/"] port/locals/headers: headers: Parse-Header HTTP-Header headers port/size: 0 if querying [if headers/Content-Length [port/size: load headers/Content-Length]] if error? try [port/date: parse-header-date headers/Last-Modified] [port/date: none] if not error? try [port/locals/headers/Set-Cookie] [ set-cookies-http port ] port/status: 'file ] error: [ system/words/close port/sub-port net-error reform ["Error. Target url:" port/url "could not be retrieved. Server response:" response-line] ] forward: [ page: copy "" while [(str: pick port/sub-port 1) <> ""] [append page reduce [str newline]] headers: Parse-Header HTTP-Header page if not error? try [headers/Set-Cookie] [ set-cookies-http port ] insert port/locals/list port/url either found? headers/Location [ either any [find/match headers/Location "http://" find/match headers/Location "https://"] [ port/path: port/target: port/port-id: none net-utils/URL-Parser/parse-url/set-scheme port to-url port/url: headers/Location if not port/port-id: any [port/port-id all [in system/schemes port/scheme get in get in system/schemes port/scheme 'port-id]] [ net-error reform ["HTTP forwarding error: Scheme" port/scheme "for URL" port/url "not supported in this REBOL."] ] ] [ either (first headers/Location) = slash [port/path: none remove headers/Location] [either port/path [insert port/path "/"] [port/path: copy "/"]] port/target: headers/Location port/url: rejoin [lowercase to-string port/scheme "://" port/host either port/path [port/path] [""] either port/target [port/target] [""]] ] ; if find/case port/locals/list port/url [net-error reform ["Error. Target url:" port/url "could not be retrieved. Circular forwarding detected"]] system/words/close port/sub-port build-port create-request send-and-check ] [ do error] ] proxyauth: [ system/words/close port/sub-port either all [generic-proxy? (not string? get in port/proxy 'user)] [ port/proxy/user: system/schemes/http/proxy/user: port/proxy/user port/proxy/pass: system/schemes/http/proxy/pass: port/proxy/pass if not error? try [result: get in system/schemes 'https] [ result/proxy/user: port/proxy/user result/proxy/pass: port/proxy/pass ] ] [ net-error reform ["Error. Target url:" port/url "could not be retrieved: Proxy authentication denied"] ] build-port create-request send-and-check ] build-port create-request send-and-check ] query: func [port] [ if not port/locals [ querying: true open port ; port was kept open after query ; attempt for extra safety ; also note, local close on purpose attempt [close port] ; RAMBO #3718 querying: false ] none ] close: func [port] [system/words/close port/sub-port] ] if find first system/schemes 'https [ system/schemes/https/user-agent: "Mozilla/5.0 (Windows; U; Windows NT 5.1; cs; rv:1.8.0.1) Gecko/20060111 Firefox/1.5.0.1" system/schemes/https/handler: make system/schemes/https/handler [ crlf-mode?: false open: func [ port "the port to open" /local http-packet http-command response-actions success error response-line target headers http-version post-data result generic-proxy? sub-protocol build-port send-and-check create-request line continue-post tunnel-actions tunnel-success response-code forward proxyauth ][ port/locals: make object! [list: copy [] headers: none] generic-proxy?: all [port/proxy/type = 'generic not none? port/proxy/host] build-port: func [] [ sub-protocol: either port/scheme = 'https ['ssl] ['tcp] open-proto/sub-protocol/generic port sub-protocol port/url: rejoin [lowercase to-string port/scheme "://" port/host either port/port-id <> 80 [join #":" port/port-id] [copy ""] slash] if found? port/path [append port/url port/path] if found? port/target [append port/url port/target] if sub-protocol = 'ssl [ if generic-proxy? [ HTTP-Get-Header: make object! [ Host: join port/host any [all [port/port-id (port/port-id <> 80) join #":" port/port-id] #] ] user: get in port/proxy 'user pass: get in port/proxy 'pass if string? :user [ HTTP-Get-Header: make HTTP-Get-Header [ Proxy-Authorization: join "Basic " enbase join user [#":" pass] ] ] http-packet: reform ["CONNECT" HTTP-Get-Header/Host "HTTP/1.1^/"] append http-packet net-utils/export HTTP-Get-Header append http-packet "^/" net-utils/net-log http-packet insert port/sub-port http-packet continue-post/tunnel ] system/words/set-modes port/sub-port [secure: true] ] ] http-command: either querying ["HEAD"] ["GET"] create-request: func [/local target user pass u] [ HTTP-Get-Header: make object! [ Accept: "*/*" Connection: "close" User-Agent: get in get in system/schemes port/scheme 'user-agent Host: join port/host any [all [port/port-id (port/port-id <> 80) join #":" port/port-id] #] ] if all [block? port/state/custom post-data: select port/state/custom 'header block? post-data] [ HTTP-Get-Header: make HTTP-Get-Header post-data ] HTTP-Header: make object! [ Date: Server: Last-Modified: Accept-Ranges: Content-Encoding: Content-Type: Content-Length: Location: Expires: Referer: Connection: Authorization: none ] http-version: "HTTP/1.0^/" all [port/user port/pass HTTP-Get-Header: make HTTP-Get-Header [Authorization: join "Basic " enbase join port/user [#":" port/pass]]] user: get in port/proxy 'user pass: get in port/proxy 'pass if all [generic-proxy? string? :user] [ HTTP-Get-Header: make HTTP-Get-Header [ Proxy-Authorization: join "Basic " enbase join user [#":" pass] ] ] if port/state/index > 0 [ http-version: "HTTP/1.1^/" HTTP-Get-Header: make HTTP-Get-Header [ Range: rejoin ["bytes=" port/state/index "-"] ] ] target: next mold to-file join (join "/" either found? port/path [port/path] [""]) either found? port/target [port/target] [""] post-data: none if all [block? port/state/custom post-data: find port/state/custom 'post post-data/2] [ http-command: "POST" HTTP-Get-Header: make HTTP-Get-Header append [ Referer: either find port/url #"?" [head clear find copy port/url #"?"] [port/url] Content-Type: "application/x-www-form-urlencoded" Content-Length: length? post-data/2 ] either block? post-data/3 [post-data/3] [[]] post-data: post-data/2 ] http-packet: reform [http-command either generic-proxy? [port/url] [target] http-version] append http-packet net-utils/export HTTP-Get-Header append http-packet get-cookies port if all [crlf-mode? port/scheme = 'https][ append http-packet "^/" replace/all http-packet lf crlf ] http-packet ] send-and-check: func [] [ net-utils/net-log http-packet insert port/sub-port http-packet if post-data [write-io port/sub-port post-data length? post-data] continue-post ] continue-post: func [/tunnel /local digit space] [ response-line: system/words/pick port/sub-port 1 net-utils/net-log response-line either none? response-line [do error] [ digit: charset "1234567890" space: charset " ^-" either parse/all response-line [ "HTTP/" digit "." digit some space copy response-code 3 digit to end ] [ response-code: to integer! response-code result: select either tunnel [tunnel-actions] [response-actions] response-code either none? result [do error] [do get result] ] [ port/status: 'file ] ] ] tunnel-actions: [ 200 tunnel-success ] response-actions: [ 100 continue-post 200 success 201 success 204 success 206 success 300 forward 301 forward 302 forward 304 success 407 proxyauth ] tunnel-success: [ while [(line: pick port/sub-port 1) <> ""] [net-log line]] success: [ headers: make string! 500 while [(line: pick port/sub-port 1) <> ""] [append headers join line "^/"] port/locals/headers: headers: Parse-Header HTTP-Header headers port/size: 0 if querying [if headers/Content-Length [port/size: load headers/Content-Length]] if error? try [port/date: parse-header-date headers/Last-Modified] [port/date: none] if not error? try [port/locals/headers/Set-Cookie] [ set-cookies-http port ] port/status: 'file ] error: [ system/words/close port/sub-port net-error reform ["Error. Target url:" port/url "could not be retrieved. Server response:" response-line] ] forward: [ page: copy "" while [(str: pick port/sub-port 1) <> ""] [append page reduce [str newline]] headers: Parse-Header HTTP-Header page if not error? try [headers/Set-Cookie] [ set-cookies-http port ] insert port/locals/list port/url either found? headers/Location [ either any [find/match headers/Location "http://" find/match headers/Location "https://"] [ port/path: port/target: port/port-id: none net-utils/URL-Parser/parse-url/set-scheme port to-url port/url: headers/Location if not port/port-id: any [port/port-id all [in system/schemes port/scheme get in get in system/schemes port/scheme 'port-id]] [ net-error reform ["HTTP forwarding error: Scheme" port/scheme "for URL" port/url "not supported in this REBOL."] ] ] [ either (first headers/Location) = slash [port/path: none remove headers/Location] [either port/path [insert port/path "/"] [port/path: copy "/"]] port/target: headers/Location port/url: rejoin [lowercase to-string port/scheme "://" port/host either port/path [port/path] [""] either port/target [port/target] [""]] ] ; if find/case port/locals/list port/url [net-error reform ["Error. Target url:" port/url {could not be retrieved. Circular forwarding detected}]] system/words/close port/sub-port build-port create-request send-and-check ] [ do error ] ] proxyauth: [ system/words/close port/sub-port either all [generic-proxy? (not string? get in port/proxy 'user)] [ port/proxy/user: system/schemes/http/proxy/user: port/proxy/user port/proxy/pass: system/schemes/http/proxy/pass: port/proxy/pass if not error? try [result: get in system/schemes 'https] [ result/proxy/user: port/proxy/user result/proxy/pass: port/proxy/pass ] ] [ net-error reform ["Error. Target url:" port/url {could not be retrieved: Proxy authentication denied}] ] build-port create-request send-and-check ] build-port create-request send-and-check ] query: func [port][ if not port/locals [ querying: true open port attempt [close port] querying: false ] none ] ] ]
halt ;; to terminate script if DO'ne from webpage
Notes