* Better error message when a tcp connection is refused.

* implemented udp connections (not working yet).

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)

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")

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)
+  (define-syntax define-connector 
-    (socket->ports 
+    (syntax-rules ()
-      (foreign-call "ikrt_tcp_connect" 
+      [(_ who foreign-name)
-        (string->utf8 host) (string->utf8 srvc))
+       (define (who host srvc)
-      'tcp-connect
+         (unless (and (string? host) (string? srvc))
-      (string-append host ":" 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)))
   )
 

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]

src/ikarus-io.c

@@ -25,12 +25,17 @@
 #include <unistd.h>
 #include <sys/socket.h>
 #include <netdb.h>
+#include <string.h>
 
 #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
+static ikptr
-ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){
+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){
+ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){
-  ikptr fdptr = ikrt_tcp_connect(host, srvc, 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;