;; -*- Mode: Irken -*-

;; ok, how about some socket action?

(include "lib/basis.scm")

(cinclude "sys/types.h")
(cinclude "sys/socket.h")
(cinclude "netinet/in.h")
(cinclude "arpa/inet.h")

(define PF_INET		(%%cexp int "PF_INET"))
(define SOCK_STREAM	(%%cexp int "SOCK_STREAM"))
(define AF_INET         (%%cexp int "AF_INET"))

(define (socket family type protocol)
  (%%cexp (int int int -> int)
	  "socket (%0, %1, %2)"
	  family type protocol))

(define (inet_pton af ascii buf)
  (%%cexp (int string (buffer (struct sockaddr_in)) -> int)
	  "inet_pton (%0, %1, &(%2->sin_addr))"
	  af ascii buf))

(define (inet_ntop af buf)
  (let ((ascii (make-string 100))
	(r (%%cexp (int (buffer (struct sockaddr_in)) string int -> int)
		   "inet_ntop (%0, &(%1->sin_addr), %2, %3)"
		   af buf ascii (string-length ascii))))
    ;; should strip this to NUL
    ascii))

(define (make-in-addr ip port)
  (let ((ss (%callocate (struct sockaddr_in) 1)))
    (%%cexp ((buffer (struct sockaddr_in)) -> undefined) "(%0->sin_family = PF_INET, PXLL_UNDEFINED)" ss)
    (%%cexp ((buffer (struct sockaddr_in)) int -> undefined) "(%0->sin_port = htons(%1), PXLL_UNDEFINED)" ss port)
    (trysys (inet_pton AF_INET ip ss))
    ss))

(define (bind fd addr)
  (%%cexp (int (buffer (struct sockaddr_in)) -> int)
	  "bind (%0, (struct sockaddr *) %1, sizeof(struct sockaddr_in))"
	  fd addr))

(define (listen fd backlog)
  (%%cexp (int int -> int) "listen (%0, %1)" fd backlog))

(define (accept fd)
  (let ((sockaddr (%callocate (struct sockaddr_in) 1))
	(address-len (%callocate socklen_t 1)))
    (%%cexp ((buffer socklen_t) -> undefined) "(*%0 = sizeof(struct sockaddr_in), PXLL_UNDEFINED)" address-len)
    (%%cexp (int (buffer (struct sockaddr_in)) (buffer socklen_t) -> int)
	    "accept (%0, (struct sockaddr *) %1, %2)"
	    fd sockaddr address-len)))

(cinclude "sys/errno.h")

(define (trysys retval)
  (if (< retval 0)
      (error1 "system error" (copy-cstring (%%cexp (-> cstring) "strerror(errno)" )))
      retval))

(let ((s (socket PF_INET SOCK_STREAM 0))
      (ss (%callocate (struct sockaddr_in) 1))
      (addrlen (inet_pton AF_INET "16.1.0.2" ss))
      (in-addr (make-in-addr "127.0.0.1" 8888))
      )
  (print-string (format "s = " (int s) "\n"))
  (printn addrlen)
  (if (> addrlen 0)
      (printn (inet_ntop AF_INET ss))
      (print-string "inet_ntop failed\n"))
  (trysys (bind s in-addr))
  (trysys (listen s 5))
  (let ((fd (trysys (accept s))))
    (printn (write fd "testing, testing!\r\n"))
    (close fd)
    (close s)))