#! /usr/local/bin/gforth031 \ make our directory the search directory \ sourcefilename extractpath fpath only-path decimal require ./../wordlibs/unixlib.fs require ./netlib.fs \ require jflib/tools/fieldscan.fs : usage ." httpclient.fs [ -p port ] [ -t timeout ] [ -s ] [ -r ] [ -b filename ] [ -e filename ]" cr ." -h host resource-name" cr ." Options:" cr ." -p N Set portnumber to N (default is 80)" cr ." -t N Set timeout to N (default is no timeout)" cr ." -b name Save body (data) of response to file named name" cr ." -e name Save header of response to file name" cr ." -h host set host to host (dault is localhost)" cr ." -r make an report" cr ." -s silent operation, don't view requested data" cr bye ; Create hostname ," localhost" 300 chars allot Variable port 80 port ! Variable timeout 0 timeout ! Variable silent-flag silent-flag off Variable result-flag result-flag off Create crlf 13 c, 10 c, 13 c, 10 c, Create wbuffer 300 chars allot Create rbuffer 1000 chars allot Variable Headerbytes 0 Headerbytes ! Variable Databytes 0 Databytes ! Variable StatusCode Create Protocol 100 chars allot Create ReasonPhrase 100 chars allot 0 Value header-fd 0 Value data-fd : .args argc @ 0 DO ." arg " i . ." : " i arg type cr LOOP ; 0 Value optind : end? ( -- flag) optind argc @ u>= ; : arg? ( -- adr len ) \G get next argument end? ABORT" too few arguments!" optind arg 1 optind + to optind ; : scanarg 2 to optind end? IF usage THEN BEGIN end? 0= WHILE optind arg IF c@ [char] - = IF optind arg 1 optind + to optind forth-wordlist search-wordlist 0= ABORT" wrong option!" execute -1 ELSE false THEN ELSE true THEN WHILE REPEAT THEN ; : -? usage ; : -h arg? hostname place ; : -p 0.0 arg? >number 2drop d>s port ! ; : -t 0.0 arg? >number 2drop d>s port ! ; : -s silent-flag on ; : -r result-flag on ; : -b arg? r/w bin create-file throw to data-fd ; : -e arg? r/w bin create-file throw to header-fd ; : fd-readline ( adr len fd -- u ior ) >r over + r> { startadr endadr fd } startadr BEGIN dup 1 fd uread ?dup IF nip startadr - EXIT THEN IF dup c@ CASE 10 OF startadr - 0 EXIT ENDOF 13 OF ENDOF dup OF char+ ENDOF ENDCASE THEN dup endadr = UNTIL startadr - 0 ; : fieldscan ( adr len c -- adr2 len2 adr3 len3 ) >r 2dup r> scan { ia il ra rl } ra rl dup IF -1 /string THEN ia ra ia - ; : http-header ( sd -- ior ) { sd } break: \ read 1st line rbuffer 1000 sd fd-readline ?dup ?EXIT rbuffer swap bl fieldscan 100 min Protocol place bl fieldscan 0 -rot 0 -rot >number 2drop d>s StatusCode ! bl fieldscan 100 min ReasonPhrase place 2drop \ read until empty line BEGIN rbuffer 1000 sd fd-readline ?dup IF nip EXIT THEN dup WHILE dup 2 + HeaderBytes +! rbuffer swap silent-flag @ 0= IF 2dup type cr THEN header-fd IF header-fd write-line drop ELSE 2drop THEN REPEAT silent-flag @ 0= IF cr THEN ; : http-body ( sd -- ior ) { sd } BEGIN rbuffer 200 sd uread -39 <> WHILE dup DataBytes +! rbuffer swap silent-flag @ 0= IF 2dup type cr THEN data-fd IF data-fd write-file drop ELSE 2drop THEN REPEAT 0 ; : http-data ( sd -- ior ) { sd } sd http-header ?dup ?EXIT sd http-body ; : main end? ABORT" no file specified!" timeout @ ?dup IF alarm THEN hostname count port @ connect-tcp-name { sd } s" GET " wbuffer place optind arg wbuffer +place s" HTTP/1.0" wbuffer +place crlf 4 wbuffer +place \ crlf char+ 1 wbuffer +place \ crlf char+ 1 wbuffer +place \ crlf 4 wbuffer +place \ wbuffer count type cr break: wbuffer count sd uwrite throw drop sd http-data drop sd uclose throw result-flag @ IF ." returnstatus=okay" cr ." statuscode=" StatusCode @ 0 u.r cr ." reasonphrase=" [char] " emit ReasonPhrase count type [char] " emit cr ." headerbytes=" HeaderBytes @ 0 u.r cr ." databytes=" DataBytes @ 0 u.r cr THEN header-fd ?dup IF close-file throw THEN data-fd ?dup IF close-file throw THEN ; : (DoError2) ( throw-code -- ) Result-Flag @ IF ." returnstatus=failed" cr THEN outfile-id dup flush-file drop >r stderr to outfile-id dup -2 = IF "error @ ?dup IF cr count type THEN drop ELSE .error THEN normal-dp dpp ! r> to outfile-id ; ' (DoError2) IS DoError scanarg main bye