118 lines
2.1 KiB
Scheme
118 lines
2.1 KiB
Scheme
(load-shared-object "libc.so.6")
|
|
|
|
(define (domain->int flag)
|
|
(case flag
|
|
((AF_INET) 2)
|
|
))
|
|
|
|
(define (type->int flag)
|
|
(case flag
|
|
((SOCK_DGRAM) 2)
|
|
((SOCK_DCCP) 6)
|
|
))
|
|
|
|
(define (protocol->int flag)
|
|
(case flag
|
|
((IPPROTO_IP) 0)
|
|
((IPPROTO_DCCP) 33)
|
|
))
|
|
|
|
(define (perror str)
|
|
((foreign-procedure
|
|
"perror"
|
|
(string)
|
|
void) str))
|
|
|
|
(define (socket domain type protocol)
|
|
((foreign-procedure
|
|
"socket"
|
|
(int int int)
|
|
int)
|
|
(domain->int domain)
|
|
(type->int type)
|
|
(protocol->int protocol)))
|
|
|
|
(define-ftype
|
|
[in_addr
|
|
(struct
|
|
(s_addr unsigned-long))]
|
|
|
|
[sockaddr_in
|
|
(struct
|
|
(sin_family short)
|
|
(sin_port unsigned-short)
|
|
(sin_addr in_addr)
|
|
(sin_zero (array 8 char)))]
|
|
)
|
|
|
|
(define (level->int flag)
|
|
(case flag
|
|
((SOL_SOCKET) #x1)
|
|
))
|
|
|
|
(define (optname->int flag)
|
|
(case flag
|
|
((SO_REUSEADDR) #x2)
|
|
))
|
|
|
|
(define (inet_pton af src dst)
|
|
((foreign-procedure
|
|
"inet_pton"
|
|
(int string void*)
|
|
int)
|
|
(domain->int af)
|
|
src dst))
|
|
|
|
(define (inet_ntop af src dst size)
|
|
((foreign-procedure
|
|
"inet_ntop"
|
|
(int void* (* char) int)
|
|
string)
|
|
(domain->int af)
|
|
src dst size))
|
|
|
|
(define (htons host)
|
|
((foreign-procedure "htons" (unsigned-16) unsigned-16) host))
|
|
|
|
(define (ntohs net)
|
|
((foreign-procedure "ntohs" (unsigned-16) unsigned-16) net))
|
|
|
|
(define (setsockopt sockfd level optname optval optlen)
|
|
((foreign-procedure
|
|
"setsockopt"
|
|
(int int int void* int)
|
|
int)
|
|
sockfd
|
|
(level->int level)
|
|
(optname->int optname)
|
|
optval optlen))
|
|
|
|
(define (bind sockfd address address_len)
|
|
((foreign-procedure
|
|
"bind"
|
|
(int void* int)
|
|
int) sockfd address address_len))
|
|
|
|
(define (listen sockfd backlog)
|
|
((foreign-procedure
|
|
"listen"
|
|
(int int)
|
|
int) sockfd backlog))
|
|
|
|
(define (msgflag->int flag)
|
|
(case flag
|
|
((MSG_DEFAULT) 0)
|
|
))
|
|
|
|
(define (recvfrom sockfd buf len msgflag src-addr addrlen)
|
|
((foreign-procedure
|
|
"recvfrom"
|
|
(int void* int int (* sockaddr_in) (* int))
|
|
int)
|
|
sockfd
|
|
buf
|
|
len
|
|
(msgflag->int msgflag)
|
|
src-addr
|
|
addrlen))
|