test.ss
;; mzsocket: BSD/POSIX sockets library for mzscheme
;; Copyright (C) 2007 Dimitris Vyzovitis <vyzo@media.mit.edu>
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 2.1 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
;; USA

(module test mzscheme
  (require (lib "check.ss" "srfi" "78"))
  (require "socket.ss"
           (only "install.ss" get-version))

  (define (make-junk len)
    (let ((buf (make-bytes len)))
      (do ((i 0 (add1 i)))
          ((= i len) buf)
        (bytes-set! buf i (random 255)))))

  (define (bind-server sock where)
    (with-handlers*
        ((exn:socket?
          (lambda (e)
            (if (= (exn:socket-errno e) errno:EADDRINUSE)
                #f
                (raise e)))))
      (socket-bind sock where)))

  (define (socket-maker make-sock make-addr make-val)
    (lambda (lo hi)
      (let ((sock (make-sock)))
        (socket-setsockopt sock SOL_SOCKET SO_REUSEADDR #t)
        (let lp ((x lo))
          (if (< x hi)
              (if (bind-server sock (make-addr x))
                  (make-val sock)
                  (lp (add1 x)))
              (error 'socket-maker "can't bind"))))))

  (define tcp-server-socket
    (socket-maker 
     socket
     (lambda (port) (inet4-address INADDR_LOOPBACK port))
     (lambda (sock) (socket-listen sock 1) sock)))
  
  (define unix-server-socket
    (socket-maker
     (lambda () (socket PF_UNIX))
     (lambda (x) (string->path (format "/tmp/test-~a~a" x (random))))
     (lambda (sock) (socket-listen sock 1) sock)))

  (define udp-server-socket
    (socket-maker
     (lambda () (socket PF_INET SOCK_DGRAM))
     (lambda (port) (inet4-address INADDR_ANY port))
     (lambda (sock) sock)))

  (define (stream-server sock)
    (define buf (make-bytes 4096))
    (let-values (((cli cliaddr) (socket-accept sock)))
      (let lp ()
        (let ((ilen (socket-recv cli buf)))
          (if (> ilen 0)
              (begin
                (socket-send-all cli buf 0 ilen)
                (lp))
              (begin
                (socket-close cli)
                (stream-server sock)))))))

  (define (stream-client srv pf len)
    (define-values (sbuf rbuf) (values (make-junk len) (make-bytes len)))
    (define sock (socket pf SOCK_STREAM))
    (socket-connect sock srv)
    (check (socket-send-all sock sbuf) => (bytes-length sbuf))
    (check (socket-recv-all sock rbuf) => (bytes-length rbuf))
    (check (equal? rbuf sbuf) => #t)
    (socket-close sock))
  
  (define (dgram-server sock)
    (define buf (make-bytes 1500))
    (let lp ()
      (let-values (((ilen peer) (socket-recvfrom sock buf)))
        (check (socket-sendto sock peer buf 0 ilen) => ilen)
        (lp))))
  
  (define (dgram-client srv len)
    (define-values (sbuf rbuf) (values (make-junk len) (make-bytes len)))
    (define sock (socket PF_INET SOCK_DGRAM))
    (check (socket-sendto sock srv sbuf) => (bytes-length sbuf))
    (let-values (((ilen peer) (socket-recvfrom sock rbuf)))
      (check ilen => (bytes-length rbuf))
      (check (inet-address=? peer srv) => #t)
      (if (>= (get-version) 369.8)
          (check peer => srv))
      (check (equal? rbuf sbuf) => #t)))

  (define (bcast-client bcast len)
    (define-values (sbuf rbuf) (values (make-junk len) (make-bytes len)))
    (define sock (socket PF_INET SOCK_DGRAM))
    (socket-setsockopt sock SOL_SOCKET SO_BROADCAST #t)
    (check (socket-sendto sock bcast sbuf) => (bytes-length sbuf))
    (let-values (((ilen peer) (socket-recvfrom sock rbuf)))
      (check ilen => (bytes-length rbuf))
      (check (equal? rbuf sbuf) => #t)))

  (define (msg-server sock)
    (define data (make-bytes 1500))
    (define name (make-bytes 32))
    (let lp ()
      (let-values (((ilen nlen clen flags)
                    (socket-recvmsg sock #:name name #:data data)))
        (check (socket-sendto sock (unpack-address name) data 0 ilen) => ilen)
        (lp))))
  
  (define (msg-client srv len)
    (define-values (sbuf rbuf pbuf) 
      (values (make-junk len) (make-bytes len) (make-bytes 32)))
    (define sock (socket AF_INET SOCK_DGRAM))
    (check (socket-sendmsg sock #:name (pack-address srv) #:data sbuf)
           => (bytes-length sbuf))
    (let-values (((ilen nlen clen flags)
                  (socket-recvmsg sock #:name pbuf #:data rbuf)))
      (check ilen => (bytes-length rbuf))
      (check (equal? rbuf sbuf) => #t)
      (check (inet-address=? (unpack-address pbuf) srv) => #t)
      (if (>= (get-version) 369.8)
          (check (unpack-address pbuf) => srv))))

  (define (test-tcp)
    (let* ((srvsock (tcp-server-socket 5000 5100))
           (srvthr (thread (lambda () (stream-server srvsock))))
           (srv (socket-getsockname srvsock)))
      (stream-client srv PF_INET 128)
      (stream-client srv PF_INET 16384)
      (kill-thread srvthr)))
  
  (define (test-udp)
    (let* ((srvsock (udp-server-socket 5000 5100))
           (srvthr (thread (lambda () (dgram-server srvsock))))
           (srv (inet4-address INADDR_LOOPBACK
                  (inet-address-port (socket-getsockname srvsock)))))
      (sleep 1)
      (dgram-client srv 1024)
      (kill-thread srvthr)))

  (define (test-bcast)
    (let* ((srvsock (udp-server-socket 5000 5100))
           (bcast (inet4-address INADDR_BROADCAST 
                    (inet-address-port (socket-getsockname srvsock)))))
      (socket-setsockopt srvsock SOL_SOCKET SO_BROADCAST #t)
      (let ((srvthr (thread (lambda () (dgram-server srvsock)))))
        (sleep 1)
        (bcast-client bcast 1024)
        (kill-thread srvthr))))
  
  (define (test-msg)
    (let* ((srvsock (udp-server-socket 5000 5100))
           (srvthr (thread (lambda () (msg-server srvsock))))
           (srv (inet4-address INADDR_LOOPBACK 
                  (inet-address-port (socket-getsockname srvsock)))))
      (sleep 1)
      (msg-client srv 1024)
      (kill-thread srvthr)))
  
  (define (test-unix)
    (let* ((srvsock (unix-server-socket 0 100))
           (srvthr (thread (lambda () (stream-server srvsock))))
           (srv (socket-getsockname srvsock)))
      (stream-client srv PF_UNIX 4096)
      (kill-thread srvthr)
      (delete-file srv)))
  
  (define (run-suite tests)
    (for-each (lambda (test) (test)) tests))
  
  (define unix-suite 
    (list test-tcp test-udp test-bcast test-msg test-unix))
  (define windows-suite 
    (list test-tcp test-udp test-bcast))
  
  (define (run-tests)
    (case (system-type)
      ((windows) (run-suite windows-suite))
      (else (run-suite unix-suite)))
    (check-report))
  
  (provide run-tests)
)