diff --git a/lab/tcp-chargen-client.ss b/lab/tcp-chargen-client.ss new file mode 100755 index 0000000..0c32748 --- /dev/null +++ b/lab/tcp-chargen-client.ss @@ -0,0 +1,23 @@ +#!/usr/bin/env scheme-script + +(import (ikarus)) + +;;; very simple demo for how to connect to a chargen server, +;;; and print everything that it returns. + +(define (chargen host) + (let-values ([(op ip) (tcp-connect host "chargen")]) + (let ([ip (transcoded-port ip (native-transcoder))]) + (close-output-port op) + (call/cc + (lambda (k) + (with-exception-handler + k + (lambda () + (let f () + (display (get-string-n ip 72)) + (f)))))) + (close-input-port ip)))) + +(chargen "localhost") +(newline) diff --git a/lab/tcp-pingpong.ss b/lab/tcp-pingpong.ss new file mode 100755 index 0000000..3ed6158 --- /dev/null +++ b/lab/tcp-pingpong.ss @@ -0,0 +1,31 @@ +#!/usr/bin/env scheme-script +(import (ikarus)) + +(define max-bytes 100000000) + +(define devrand (open-file-input-port "/dev/urandom")) + +(define (rand-length) + (add1 (mod + (bytevector-u16-ref (get-bytevector-n devrand 2) 0 'little) + 1024))) + +(define (echo host) + (printf "Connecting\n") + (let-values ([(op ip) (tcp-connect host "echo")]) + (printf "Connected\n") + (let f ([bytes 0]) + (printf "~s " bytes) + (when (<= bytes max-bytes) + (let ([n (rand-length)]) + (let ([bv (get-bytevector-n devrand n)]) + (put-bytevector op bv) + (flush-output-port op) + (let ([v (get-bytevector-n ip n)]) + (assert (equal? v bv))) + (f (+ bytes n)))))) + (close-input-port ip) + (close-output-port op) + (newline))) + +(echo "localhost") diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss index df36f3a..69b18c9 100644 --- a/scheme/ikarus.io.ss +++ b/scheme/ikarus.io.ss @@ -64,6 +64,7 @@ process tcp-connect tcp-connect-nonblocking + udp-connect udp-connect-nonblocking ) @@ -116,7 +117,9 @@ port-id input-port-byte-position process - tcp-connect tcp-connect-nonblocking)) + tcp-connect tcp-connect-nonblocking + udp-connect udp-connect-nonblocking + )) (module UNSAFE (fx< fx<= fx> fx>= fx= fx+ fx- @@ -1181,7 +1184,8 @@ #| 19 |# "file already exists" #| 20 |# "invalid file name" #| 21 |# "non-blocking operation would block" - #| 22 |# "broken pipe (e.g., writing to a closed process or socket)")) + #| 22 |# "broken pipe (e.g., writing to a closed process or socket)" + #| 23 |# "connection refused")) (define (io-error who id err) (let ([err (fxnot err)]) @@ -2052,7 +2056,7 @@ (define (socket->ports socket who id) (if (< socket 0) - (io-error 'tcp-connect id socket) + (io-error who id socket) (let ([close (let ([closed-once? #f]) (lambda () @@ -2065,18 +2069,22 @@ (fh->input-port socket id input-file-buffer-size #f close who))))) - (define (tcp-connect host srvc) - (socket->ports - (foreign-call "ikrt_tcp_connect" - (string->utf8 host) (string->utf8 srvc)) - 'tcp-connect - (string-append host ":" srvc))) + (define-syntax define-connector + (syntax-rules () + [(_ who foreign-name) + (define (who host srvc) + (unless (and (string? host) (string? srvc)) + (die 'who "host and service must both be strings" host srvc)) + (socket->ports + (foreign-call foreign-name + (string->utf8 host) (string->utf8 srvc)) + 'who + (string-append host ":" srvc)))])) + + (define-connector tcp-connect "ikrt_tcp_connect") + (define-connector udp-connect "ikrt_udp_connect") + (define-connector tcp-connect-nonblocking "ikrt_tcp_connect_nonblocking") + (define-connector udp-connect-nonblocking "ikrt_udp_connect_nonblocking") - (define (tcp-connect-nonblocking host srvc) - (socket->ports - (foreign-call "ikrt_tcp_connect_nonblocking" - (string->utf8 host) (string->utf8 srvc)) - 'tcp-connect-nonblocking - (string-append host ":" srvc))) ) diff --git a/scheme/makefile.ss b/scheme/makefile.ss index f8b43e3..6489d19 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1394,7 +1394,9 @@ [&i/o-would-block-rtd] [&i/o-would-block-rcd] [tcp-connect i] + [udp-connect i] [tcp-connect-nonblocking i] + [udp-connect-nonblocking i] [&i/o-would-block i] [make-i/o-would-block-condition i] [i/o-would-block-condition? i] diff --git a/src/ikarus-io.c b/src/ikarus-io.c index 57e6206..0339adb 100644 --- a/src/ikarus-io.c +++ b/src/ikarus-io.c @@ -25,12 +25,17 @@ #include #include #include +#include #include "ikarus-data.h" ikptr ikrt_io_error(){ - switch(errno){ + int err = errno; +#if 0 + fprintf(stderr, "errno=%d %s\n", err, strerror(err)); +#endif + switch(err){ case EBADF : return fix(-2); case EINTR : return fix(-3); case ENOTDIR : return fix(-4); @@ -53,6 +58,7 @@ ikrt_io_error(){ case EINVAL : return fix(-21); case EAGAIN : return fix(-22); /* hardcoded in ikarus.io.ss */ case EPIPE : return fix(-23); + case ECONNREFUSED : return fix(-24); } return fix(-1); } @@ -107,13 +113,18 @@ ikrt_open_output_fd(ikptr fn, ikptr ikopts, ikpcb* pcb){ } - ikptr ikrt_read_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){ +#if 0 + fprintf(stderr, "READ: %d\n", unfix(fd)); +#endif ssize_t bytes = read(unfix(fd), (char*)(long)(bv+off_bytevector_data+unfix(off)), unfix(cnt)); +#if 0 + fprintf(stderr, "BYTES: %d\n", bytes); +#endif if(bytes >= 0){ return fix(bytes); } else { @@ -136,8 +147,8 @@ ikrt_write_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){ -ikptr -ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){ +static ikptr +do_connect(ikptr host, ikptr srvc, int socket_type){ struct addrinfo* info; int err = getaddrinfo((char*)(long)(host+off_bytevector_data), (char*)(long)(srvc+off_bytevector_data), @@ -149,7 +160,7 @@ ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){ struct addrinfo* i = info; int sock = -1; while(i){ - if(i->ai_socktype != SOCK_STREAM){ + if(i->ai_socktype != socket_type){ i = i->ai_next; } else { int s = socket(i->ai_family, i->ai_socktype, i->ai_protocol); @@ -171,8 +182,17 @@ ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){ } ikptr -ikrt_tcp_connect_nonblocking(ikptr host, ikptr srvc, ikpcb* pcb){ - ikptr fdptr = ikrt_tcp_connect(host, srvc, pcb); +ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){ + return do_connect(host, srvc, SOCK_STREAM); +} + +ikptr +ikrt_udp_connect(ikptr host, ikptr srvc, ikpcb* pcb){ + return do_connect(host, srvc, SOCK_DGRAM); +} + +static ikptr +do_unblock(ikptr fdptr){ int fd = unfix(fdptr); if(fd >= 0){ /* connected alright */ @@ -186,6 +206,17 @@ ikrt_tcp_connect_nonblocking(ikptr host, ikptr srvc, ikpcb* pcb){ return fdptr; } +ikptr +ikrt_tcp_connect_nonblocking(ikptr host, ikptr srvc, ikpcb* pcb){ + return do_unblock(ikrt_tcp_connect(host, srvc, pcb)); +} + +ikptr +ikrt_udp_connect_nonblocking(ikptr host, ikptr srvc, ikpcb* pcb){ + return do_unblock(ikrt_udp_connect(host, srvc, pcb)); +} + + ikptr ikrt_file_ctime(ikptr filename, ikptr res){ struct stat s;