Added a tcp-connect procedure that takes a host name and a service

name (e.g. "www.google.com" and "http") and returns two binary ports:
the first for output and the second for input.
Both ports must be closed for the connection to close.

Also added an example in lab/tcp-connect-example.ss which connects 
to an http server, sends "GET /\n" and prints the responde.

lab/tcp-connect-example.ss

@@ -0,0 +1,19 @@
+#!/usr/bin/env scheme-script
+
+(import (ikarus))
+
+;;; very simple demo for how to connect to a server, 
+;;; send a request and receive a response.
+
+(define (http-cat host)
+  (let-values ([(op ip) (tcp-connect 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")
+(http-cat "127.0.0.1")
+

scheme/ikarus.io.ss

@@ -61,7 +61,10 @@
     reset-input-port!
     port-id
     input-port-byte-position
-    process )
+    process 
+    
+    tcp-connect
+    )
 
   
   (import 
@@ -111,7 +114,8 @@
       reset-input-port!
       port-id
       input-port-byte-position
-      process))
+      process
+      tcp-connect))
 
   (module UNSAFE  
     (fx< fx<= fx> fx>= fx= fx+ fx-
@@ -1180,7 +1184,7 @@
   (define input-file-buffer-size (+ block-size 128))
   (define output-file-buffer-size block-size)
 
-  (define (fh->input-port fd id size transcoder close?)
+  (define (fh->input-port fd id size transcoder close)
     (guarded-port
       ($make-port 
         (input-transcoder-attrs transcoder)
@@ -1196,15 +1200,13 @@
         #f ;;; write!
         #f ;;; get-position
         #f ;;; set-position!
-        (and close?
-          (lambda () 
-            (cond
-              [(foreign-call "ikrt_close_fd" fd) =>
-               (lambda (err) 
-                 (io-error 'close id err))])))
+        (cond
+          [(procedure? close) close]
+          [(eqv? close #t) (file-close-proc id fd)]
+          [else #f])
         fd)))
 
-  (define (fh->output-port fd id size transcoder close?)
+  (define (fh->output-port fd id size transcoder close)
     (guarded-port
       ($make-port 
         (output-transcoder-attrs transcoder)
@@ -1220,14 +1222,19 @@
             bytes))
         #f ;;; get-position
         #f ;;; set-position!
-        (and close?
-          (lambda () 
-            (cond
-              [(foreign-call "ikrt_close_fd" fd) =>
-               (lambda (err) 
-                 (io-error 'close id err))])))
+        (cond
+          [(procedure? close) close]
+          [(eqv? close #t) (file-close-proc id fd)]
+          [else #f])
         fd)))
 
+  (define (file-close-proc id fd)
+    (lambda () 
+      (cond
+        [(foreign-call "ikrt_close_fd" fd) =>
+         (lambda (err) 
+           (io-error 'close id err))])))
+
   (define (open-input-file-handle filename who)
     (let ([fh (foreign-call "ikrt_open_input_fd"
                  (string->utf8 filename))])
@@ -1902,6 +1909,24 @@
             (fh->input-port (vector-ref r 3) 
                 cmd input-file-buffer-size #f #t)))))
 
+  (define (tcp-connect host srvc)
+    (let ([socket (foreign-call "ikrt_tcp_connect" 
+                     (string->utf8 host)
+                     (string->utf8 srvc))])
+      (if (< socket 0)
+          (io-error 'tcp-connect host socket)
+          (let ([close
+                 (let ([closed-once? #f])
+                   (lambda () 
+                     (if closed-once?
+                         ((file-close-proc host socket))
+                         (set! closed-once? #t))))])
+            (values 
+              (fh->output-port socket
+                 host output-file-buffer-size #f close)
+              (fh->input-port socket
+                 host input-file-buffer-size #f close))))))
+
 
   )
 

scheme/last-revision

@@ -1 +1 @@
-1288
+1289

scheme/makefile.ss

@@ -1373,6 +1373,7 @@
     [&no-nans-rcd]
     [&interrupted-rtd]
     [&interrupted-rcd]
+    [tcp-connect                i]
   ))
 
 (define (macro-identifier? x) 

src/ikarus-io.c

@@ -5,6 +5,8 @@
 #include <sys/stat.h>
 #include <sys/uio.h>
 #include <unistd.h>
+#include <sys/socket.h>
+#include <netdb.h>
 
 #include "ikarus-data.h"
 
@@ -112,3 +114,61 @@ ikrt_write_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){
   }
 }
 
+char* get_family(int x){
+  if (x == AF_UNIX) return "AF_UNIX";
+  if (x == AF_INET) return "AF_INET";
+  if (x == AF_ISO) return "AF_ISO";
+  if (x == AF_NS) return "AF_NS";
+  if (x == AF_IMPLINK) return "AF_IMPLINK";
+  return "AF_UNKNOWN";
+}
+
+char* get_type(int x){
+  if (x == SOCK_STREAM) return "SOCK_STREAM";
+  if (x == SOCK_DGRAM) return "SOCK_DGRAM";
+  if (x == SOCK_RAW) return "SOCK_RAW";
+  if (x == SOCK_SEQPACKET) return "SOCK_SEQPACKET";
+  if (x == SOCK_RDM) return "SOCK_RDM";
+  return "SOCK_UNKNOWN";
+}
+
+ikptr
+ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){
+  struct addrinfo* info;
+  int err = getaddrinfo(host+off_bytevector_data,
+                        srvc+off_bytevector_data,
+                        0,
+                        &info);
+  if(err){
+    return fix(-1);
+  }
+  struct addrinfo* i = info;
+  int sock = -1;
+  while(i){
+    if(i->ai_socktype != SOCK_STREAM){
+      i = i->ai_next;
+    } else {
+      int s = socket(i->ai_family, i->ai_socktype, i->ai_protocol);
+      if(s < 0){
+        i = i->ai_next;
+      } else {
+        int err = connect(s, i->ai_addr, i->ai_addrlen);
+        if(err < 0){
+          i = i->ai_next;
+        } else {
+          sock = s;
+          i = 0;
+        }
+      }
+    }
+  }
+  freeaddrinfo(info);
+  return fix(sock);
+}
+
+//ikptr
+//ikrt_tcp_connect(ikp host, ikp port, ikpcb* pcb){
+//
+//}
+
+