libs/http-client/http-client.factor

   1 ! Copyright (C) 2005 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: http-client
   4 USING: errors hashtables http kernel math namespaces parser
   5 sequences io strings ;
   6
   7 : parse-host ( url -- host port )
   8     #! Extract the host name and port number from an HTTP URL.
   9     ":" split1 [ string>number ] [ 80 ] if* ;
  10
  11 : parse-url ( url -- host resource )
  12     "http://" ?head [
  13         "URL must begin with http://" throw
  14     ] unless
  15     "/" split1 [ "/" swap append ] [ "/" ] if* ;
  16
  17 : parse-response ( line -- code )
  18     "HTTP/" ?head [ " " split1 nip ] when
  19     " " split1 drop string>number ;
  20
  21 : read-response ( -- code header )
  22     #! After sending a GET or POST we read a response line and
  23     #! header.
  24     flush readln parse-response read-header ;
  25
  26 : crlf "\r\n" write ;
  27
  28 : http-request ( host resource method -- )
  29     write " " write write " HTTP/1.0" write crlf
  30     "Host: " write write crlf ;
  31
  32 : get-request ( host resource -- )
  33     "GET" http-request crlf ;
  34
  35 DEFER: http-get
  36
  37 : do-redirect ( code headers string -- code headers string )
  38     #! Should this support Location: headers that are
  39     #! relative URLs?
  40     pick 302 = [
  41         drop "Location" swap hash nip http-get
  42     ] when ;
  43
  44 : http-get ( url -- code headers string )
  45     #! Opens a stream for reading from an HTTP URL.
  46     parse-url over parse-host <client> [
  47         get-request read-response stdio get contents
  48     ] with-stream do-redirect ;
  49
  50 : download ( url file -- )
  51     #! Downloads the contents of a URL to a file.
  52     >r http-get 2nip r> <file-writer> [ write ] with-stream ;
  53
  54 : post-request ( content-type content host resource -- )
  55     #! Note: It is up to the caller to url encode the content if
  56     #! it is required according to the content-type.
  57     "POST" http-request [
  58         "Content-Length: " write length number>string write crlf
  59         "Content-Type: " write url-encode write crlf
  60         crlf
  61     ] keep write ;
  62
  63 : http-post ( content-type content url -- code headers string )
  64     #! Make a POST request. The content is URL encoded for you.
  65     parse-url over parse-host <client> [
  66         post-request flush read-response stdio get contents
  67     ] with-stream ;