(library (socket)
  (export file-write file-read bytes-ready socket bind accept close
	  socket-domain socket-type-flag socket-type gethostbyname
	  connect/inet)
  
  (import (except (chezscheme) bytevector-copy)
	  (posix)
	  (ffi-utils))

  (meta-cond
   [(memq (machine-type) '(a6le ta6le))
    
    (define-enumeration* socket-domain
      (unspec local inet ax25 ipx appletalk
	      netrom bridge atmpvc x25 inet6 rose decnet netbeui security key
	      netlink packet ash econet atmsvc rds sna irda ppox wanpipe llc ib mpls
	      can tipc bluetooth iucv rxrpc isdn phonet ieee802154 caif alg nfc
	      vsock kcm))

    (define-enumeration* socket-type (unspec stream dgram raw seqpacket dccp))
    (define-flags socket-type-flag
      (close-on-exec #o02000000)
      (non-block #o00004000))
    
    (define-ftype hostent
      (struct
       (h_name (* char))
       (h_aliases void*)
       (h_addrtype int)
       (h_length int)
       (h_addr_list void*)))
    
    (define-ftype sa_family_t unsigned-short)
    (define-ftype in_port_t unsigned-16)
    
    (define-ftype socklen_t unsigned-int)
    (define-ftype sockaddr_un
      (struct (sun_family sa_family_t)
	      (sun_data (array 108 char))))
    
    (define-ftype in_addr_t unsigned-32)
    (define-ftype in_addr
      (struct (s_addr in_addr_t)))]
   [else
    (error 'socket.sls "unsupported machine-type ~a" (machine-type))])

  
  ;; WARNING- here the size of sin_zero should be calculated on your machine as:
  #;(import (c-eval))
  #;(parameterize ([c-eval-includes '("stdio.h" "sys/socket.h" "netinet/in.h")])
		(c-eval-printf "%d" "sizeof(struct sockaddr_in) - (sizeof (sa_family_t) - sizeof(in_port_t) - sizeof(in_addr_t))"))
  ;; in my case  (a6le) -> 20
  
  (define-ftype sockaddr_in
    (struct
     (sin_family sa_family_t)
     (sin_port in_port_t)
     (sin_addr in_addr)
     (sin_zero (array 20 unsigned-8))))
  
  (define (socket domain type type-flags protocol)  
    (define socket* (foreign-procedure "socket" (int int int) int))
    (let ([r (socket* (socket-domain domain)
		      (logior (socket-type type)
			      (apply socket-type-flag type-flags))
		      protocol)])
	  (when (< r 0)
		(errorf 'socket "failed: ~a" (strerror)))
	  (open-fd-input/output-port r)))

  
  
  (define (bind s name family)
    (define strcpy* (foreign-procedure "strcpy" (void* string) void*))
    (define sun (foreign-alloc (ftype-sizeof sockaddr_un)))
    (define bind* (foreign-procedure "bind" (int void* socklen_t) int))
    (ftype-set! sockaddr_un (sun_family) sun family)
    (strcpy* (ftype-&ref sockaddr_un (sun_data) sun) name)
    (bind* (port-file-descriptor s) sun (ftype-sizeof sockaddr_un))
    (foreign-free sun))
  
  (define (accept s)
    (define accept* (foreign-procedure "accept" (int void* void*) int))
    ;;(define sun (foreign-alloc (ftype-sizeof sockaddr_un)))
    ;;(define length* (foreign-alloc (ftype-sizeof socklen_t)))
    
    (let ([r (accept* (port-file-descriptor s) 0 0)])
					;(foreign-free sun)
      (when (< r 0)
	    (errorf 'accept "failed: ~a" (strerror)))
      r))


  ;; MMM... LINUX MAN PAGES SAYS THIS IS DEPRECATED...
  (define (gethostbyname name)
    (define ghbn* (foreign-procedure "gethostbyname" (string) void*))
    (define hstrerror* (foreign-procedure "hstrerror" (int) string))
    (define (h-errno)
      (foreign-ref 'int (foreign-entry "__h_errno") 0))
    
    (let ([r (ghbn* name)])
      (when (zero? r)
	    (errorf 'gethostbyname "failed: ~a" (hstrerror* (h-errno))))
      (make-ftype-pointer hostent r)))
     
  (define (htons n)
    (define htons* (foreign-procedure "htons" (unsigned-16) unsigned-16))
    (htons* n))
  
  (define (memset dest val n)
    (define memset* (foreign-procedure "memset" (void* int size_t) void*))
    (memset* dest val n)
    (void))
  
  (define (memcpy dest src n)
    (define memcpy* (foreign-procedure "memcpy" (void* void* size_t) void*))
    (memcpy* dest src n)
    (void))
  
  (define (connect/inet socket address port)
    (define connect* (foreign-procedure "connect" (int (* sockaddr_in) socklen_t) int))
    (define server (gethostbyname address))
    (let ([addr (make-ftype-pointer sockaddr_in
				    (foreign-alloc (ftype-sizeof sockaddr_in)))])
      (memset (ftype-pointer-address addr) 0 (ftype-sizeof sockaddr_in))
      (ftype-set! sockaddr_in (sin_family) addr (socket-domain 'inet))
      (memcpy (ftype-pointer-address (ftype-&ref sockaddr_in (sin_addr) addr))
	      (foreign-ref 'void* (ftype-ref hostent (h_addr_list) server) 0)
	      (ftype-ref hostent (h_length) server))
      (ftype-set! sockaddr_in (sin_port) addr (htons port))
      (let ([r (connect* (port-file-descriptor socket)
			 addr (ftype-sizeof sockaddr_in))])
	(foreign-free (ftype-pointer-address addr))
	(when (< r 0)
	      (errorf 'connect "failed: ~a" (strerror)))))) 
  
  )


#|
;Example:
(load "socket.sls")
(import (socket))

(define (http-get hostname port q)
  (define sock (socket 'inet 'stream '() 0))
  (connect/inet sock hostname port)
  (put-bytevector sock (string->utf8 (format #f "GET ~a HTTP/1.1\r\nHost: ~a\r\nConnection: Close\r\n\r\n" q hostname)))
  (flush-output-port sock)
  (do ([c (get-u8 sock) (get-u8 sock)] 
	     [l '() (cons c l)])
    ((eof-object? c) (utf8->string (apply bytevector (reverse l))))))

(substring (http-get "scheme.com" 80 "/tspl4/intro.html") 0 100)
|#