Diff for /gforth/proxy.fs between versions 1.2 and 1.15

version 1.2, 2000/11/19 22:45:38 version 1.15, 2010/12/31 18:09:02
Line 1 Line 1
 \ a http proxy  \ a http proxy
   
 \ Copyright (C) 2000 Free Software Foundation, Inc.  \ Copyright (C) 2000,2002,2003,2006,2007,2010 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
 \ Gforth is free software; you can redistribute it and/or  \ Gforth is free software; you can redistribute it and/or
 \ modify it under the terms of the GNU General Public License  \ modify it under the terms of the GNU General Public License
 \ as published by the Free Software Foundation; either version 2  \ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.  \ of the License, or (at your option) any later version.
   
 \ This program is distributed in the hope that it will be useful,  \ This program is distributed in the hope that it will be useful,
Line 15 Line 15
 \ GNU General Public License for more details.  \ GNU General Public License for more details.
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program. If not, see http://www.gnu.org/licenses/.
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.  
   
 require unix/socket.fs  require unix/socket.fs
   require string.fs
   
 Create crlf #cr c, #lf c,  Create crlf #cr c, #lf c,
   
Line 27  Create crlf #cr c, #lf c, Line 27  Create crlf #cr c, #lf c,
   
 : request ( host u request u proxy-host u port -- fid )  : request ( host u request u proxy-host u port -- fid )
     open-socket >r      open-socket >r
     2dup type ."  HTTP/1.1" cr  
     r@ write-file throw s"  HTTP/1.1" r@ writeln      r@ write-file throw s"  HTTP/1.1" r@ writeln
     s" Host: " r@ write-file throw r@ writeln      s" Host: " r@ write-file throw r@ writeln
     ." Connection: close" cr  
     s" Connection: close" r@ writeln      s" Connection: close" r@ writeln
     s" User-Agent: " r@ write-file throw      s" User-Agent: " r@ write-file throw
     User-Agent @ IF      User-Agent @ IF
Line 38  Create crlf #cr c, #lf c, Line 36  Create crlf #cr c, #lf c,
     ELSE  s" Gforth Proxy 0.1"  THEN  r@ writeln      ELSE  s" Gforth Proxy 0.1"  THEN  r@ writeln
     s" " r@ writeln r> ;      s" " r@ writeln r> ;
   
 Variable proxy s" localhost" proxy $!  Variable proxy          \ s" proxy" proxy $! \ replace that with your proxy host
 Variable proxy-port     3128 proxy-port !  Variable proxy-port     \ 8080 proxy-port !  \ replace that with your proxy port
   
 : proxy-open ( host u request u -- fid )  \ set proxy to your local proxy, and proxy-port to your local proxy port
     proxy $@ proxy-port @ request ;  \ if you need any.
   
 : http-open ( host u request u -- fid )  : http-open ( host u request u -- fid )
     2over 80 request ;      proxy @ 0= IF  2over 80  ELSE  proxy $@ proxy-port @  THEN request ;
   
 wordlist Constant response  wordlist Constant response
 wordlist Constant response-values  wordlist Constant response-values
Line 69  Forth definitions Line 67  Forth definitions
   
 response: Allow:  response: Allow:
 response: Age:  response: Age:
   response: Accept-Ranges:
 response: Cache-Control:  response: Cache-Control:
 response: Connection:  response: Connection:
 response: Proxy-Connection:  response: Proxy-Connection:
Line 83  response: Content-Type: Line 82  response: Content-Type:
 response: Date:  response: Date:
 response: ETag:  response: ETag:
 response: Expires:  response: Expires:
 response: Last-modified:  response: Last-Modified:
 response: Location:  response: Location:
 response: Mime-Version:  response: Mime-Version:
 response: Proxy-Authenticate:  response: Proxy-Authenticate:
   response: Proxy-Connection:
 response: Public:  response: Public:
 response: Retry-After:  response: Retry-After:
 response: Server:  response: Server:
Line 132  Variable data-buffer Line 132  Variable data-buffer
     Content-Length @ IF      Content-Length @ IF
         Content-Length $@ s>number drop r> read-sized  EXIT  THEN          Content-Length $@ s>number drop r> read-sized  EXIT  THEN
     Transfer-Encoding @ IF      Transfer-Encoding @ IF
         Transfer-Encoding $@ s" chunked" compare 0= IF          Transfer-Encoding $@ s" chunked" str= IF
             r> read-chunked  EXIT  THEN  THEN              r> read-chunked  EXIT  THEN  THEN
     r> read-to-end ;      r> read-to-end ;
   
Line 158  Variable data-buffer Line 158  Variable data-buffer
   
 \ handle proxy request  \ handle proxy request
   
 : proxy-request ( host u request u -- )  : handle-request ( fid -- )
     proxy-open  
     dup >r get-response throw  
     r@ read-data r> close-file throw  
     convert-data write-response write-data ;  
   
 : http-request ( host u request u -- )  
     http-open  
     dup >r get-response throw      dup >r get-response throw
     r@ read-data r> close-file throw      r@ read-data r> close-file throw
     convert-data write-response write-data ;      convert-data write-response write-data ;
Line 191  DOES> ( -- addr u ) Line 184  DOES> ( -- addr u )
 : (redirect?) ( addr u -- addr' u' t / f )  : (redirect?) ( addr u -- addr' u' t / f )
     htmldir $! htmldir $@ bounds ?DO      htmldir $! htmldir $@ bounds ?DO
         I c@ '/ = IF  #lf I c!  THEN  LOOP          I c@ '/ = IF  #lf I c!  THEN  LOOP
     redirects 1 set-order      redirects 1 set-order redir$ $off
     htmldir $@ ['] evaluate catch      htmldir $@ ['] evaluate catch
     IF  2drop false  ELSE  true  THEN ;      IF  2drop false  ELSE  redir$ @ 0<>  THEN ;
   
 : (redirect) ( addr u -- )  : (redirect) ( -- )
     host$ $@ 2swap proxy-request maxnum off ;      host$ $@ redir$ $@ http-open handle-request maxnum off ;
   
 ' (redirect?) IS redirect?  ' (redirect?) IS redirect?
 ' (redirect) IS redirect  ' (redirect) IS redirect
Line 207  redirects set-current Line 200  redirects set-current
 get-order redirects swap 1+ set-order  get-order redirects swap 1+ set-order
   
 Vocabulary systems  Vocabulary systems
   Vocabulary humor
   
 also systems definitions  also systems definitions
   
 redirect: bigforth www.jwdt.com"http://www.jwdt.com/~paysan/"  redirect: bigforth bigforth.sourceforge.net"/"
   
   humor definitions
   
   redirect: bush www.jwdt.com"/~paysan/bush/"
   
 previous previous definitions  previous previous definitions

Removed from v.1.2  
changed lines
  Added in v.1.15


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>