diff --git a/lab/tcp-connect-nonblocking-example.ss b/lab/tcp-connect-nonblocking-example.ss new file mode 100755 index 0000000..ea872a8 --- /dev/null +++ b/lab/tcp-connect-nonblocking-example.ss @@ -0,0 +1,32 @@ +#!/usr/bin/env scheme-script + +(import (ikarus)) + +;;; very simple demo for how to connect to a server, +;;; send a request and receive a response. + +;;; Here, we use an asynchronous IO socket. We wrap the whole +;;; operation with an exception handler to handle the would-block +;;; conditions. If we do get a would-block condition, we just +;;; return, causing the read/write operation to be restarted until +;;; it succeeds. Pretty lame at this point, but it works. + +(define (http-cat host) + (with-exception-handler + (lambda (c) + ;;; just return and let it retry until it succeeds + (unless (i/o-would-block-condition? c) + (raise c))) + (lambda () + (let-values ([(op ip) (tcp-connect-nonblocking host "http")]) + (let ([op (transcoded-port op (native-transcoder))] + [ip (transcoded-port ip (native-transcoder))]) + (display "GET /\n" op) + (display (get-string-all ip)) + (close-input-port ip) + (close-output-port op)))))) + +(http-cat "www.google.com") +(newline) +;(http-cat "127.0.0.1") + diff --git a/scheme/last-revision b/scheme/last-revision index 250be2e..7a3abe9 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1293 +1294 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 9fe2743..066837a 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1380,7 +1380,7 @@ [tcp-connect-nonblocking i] [&i/o-would-block i] [make-i/o-would-block-condition i] - [i/o-would-block-condition i] + [i/o-would-block-condition? i] [i/o-would-block-port i] ))