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.
This commit is contained in:
Abdulaziz Ghuloum 2007-12-26 17:35:58 -05:00
parent b8ed235308
commit 4f0a816295
5 changed files with 122 additions and 17 deletions

19
lab/tcp-connect-example.ss Executable file
View File

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

View File

@ -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))])))
[(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,13 +1222,18 @@
bytes))
#f ;;; get-position
#f ;;; set-position!
(and close?
(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))])))
fd)))
(define (open-input-file-handle filename who)
(let ([fh (foreign-call "ikrt_open_input_fd"
@ -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))))))
)

View File

@ -1 +1 @@
1288
1289

View File

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

View File

@ -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){
//
//}