gistfile1.scm

(define (parse-url url)
  (define (parse-query url)
    (let ( (p (str-index-of url "?")) )
      (if (= p -1)
        (parse-scheme url)
        (cons (cons 'query (str-sub url p))
              (parse-scheme (str-sub url 0 p))))))

  (define (parse-scheme url)
    (let ( (p (str-index-of url "://")) )
      (if (= p -1)
        (list (cons 'pathname url))
        (cons (cons 'scheme (str-sub url 0 p))
              (parse-path (str-sub url (+ p 3)))))))

  (define (parse-path url)
    (let ( (p (str-index-of url "/")) )
      (if (= p -1)
        (cons (cons 'pathname "/")
              (parse-host url))
        (cons (cons 'pathname (str-sub url p))
              (parse-host (str-sub url 0 p))))))

  (define (parse-host url)
    (let ( (p (str-index-of url ":")) )
      (if (= p -1)
        (list (cons 'host url))
        (list (cons 'host (str-sub url 0 p))
              (cons 'port (string->num (str-sub url (+ 1 p))))))))

  (let ( (result (parse-query url))
         (pathname (assoc-ref result 'pathname))
         (query (assoc-ref result 'query)) )
    (if (nil? query)
      (cons (cons 'path pathname)
            result)
      (cons (cons 'path (str-cat pathname query))
            result))))

(define (http-request url)
  (define (read-all sock)
    (define (read-blocks sock)
      (let ( (block (socket-recv sock 4096)) )
        (if (= (str-len block) 0)
          '()
          (cons block (read-blocks sock)))))
    (apply str-cat (read-blocks sock)))

  (define (parse-response data)
    (let ( (body-start (str-index-of data "\r\n\r\n")) )
      (if (= -1 body-start)
        '())

      (str-sub data (+ body-start 4))))

  (let ( (u (if (str? url) (parse-url url) url))
         (scheme (assoc-ref u 'scheme))
         (host (assoc-ref u 'host))
         (path (assoc-ref u 'path))
         (port (assoc-ref u 'port))
         (reqport (if (nil? port) 80 port)) )

    (if (not (equal? scheme "http"))
      (error (str-cat "Unsupported scheme " scheme)))

    (let ( (sock (socket-connect host reqport)) )
      (socket-send sock (str-cat "GET " path " HTTP/1.1\r\n"
                                 "Connection: close\r\n"
                                 "Host: " host "\r\n\r\n"))
      (let ( (data (read-all sock)) )
        (socket-close sock)
        (parse-response data)))))

(if (nil? argv)
  (print "USAGE: http-client.pars URL")
  (print (http-request (car argv))))