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:
parent
b8ed235308
commit
4f0a816295
|
@ -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")
|
||||
|
|
@ -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))))))
|
||||
|
||||
|
||||
)
|
||||
|
||||
|
|
|
@ -1 +1 @@
|
|||
1288
|
||||
1289
|
||||
|
|
|
@ -1373,6 +1373,7 @@
|
|||
[&no-nans-rcd]
|
||||
[&interrupted-rtd]
|
||||
[&interrupted-rcd]
|
||||
[tcp-connect i]
|
||||
))
|
||||
|
||||
(define (macro-identifier? x)
|
||||
|
|
|
@ -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){
|
||||
//
|
||||
//}
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue