syndicate-rkt/syndicate-examples/netstack/fetchurl.rkt

36 lines
1.5 KiB
Racket

;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
#lang syndicate
(require/activate "ethernet.rkt")
(require/activate "arp.rkt")
(require/activate "ip.rkt")
(require/activate "tcp.rkt")
(require/activate "udp.rkt")
(require/activate "demo-config.rkt")
(require net/dns) ;; not syndicateish yet
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ()
(define host "www.w3.org")
(define port 80)
(define connection-id 'httpclient)
(define remote-handle (tcp-address (dns-get-address (dns-find-nameserver) host) port))
(spawn (assert (tcp-connection connection-id remote-handle))
(stop-when (asserted (tcp-rejected connection-id $reason))
(local-require racket/exn)
(printf "Connection failed:\n ~a" (exn->string reason)))
(on (asserted (tcp-accepted connection-id))
(send! (tcp-out connection-id
(bytes-append #"GET / HTTP/1.0\r\nHost: "
(string->bytes/utf-8 host)
#"\r\n\r\n"))))
(stop-when (retracted (tcp-accepted connection-id))
(printf "URL fetcher exiting.\n"))
(on (message (tcp-in connection-id $bs))
(printf "----------------------------------------\n~a\n" bs)
(printf "----------------------------------------\n"))))