#!/bin/sh
scsh <<EOF
,batch on

(define (socket-address->string socket-address)
  (call-with-values
   (lambda ()
     (socket-address->internet-address socket-address))
   (lambda (address port)
     (let ((extract (lambda (shift)
                      (number->string
                       (bitwise-and (arithmetic-shift address (- shift))
                                    255)))))
       (string-append
        (extract 24) "." (extract 16) "."
        (extract 8) "." (extract 0))))))

(define (strncmp s1 s2 n)
  (let ((s1 (substring s1 0 (min n (string-length s1))))
	(s2 (substring s2 0 (min n (string-length s2)))))
    (equal? s1 s2)))

(define (write-line s port)
  (write-string (string-append s "\n") port))

(define (client-loop socket client-addr)
  (let loop ()
    (let ((inport (socket:inport socket))
	  (outport (socket:outport socket)))
      (let ((cmd (read-line inport)))
	(cond
	 ((strncmp "ECHO " cmd 5)
	  (write-line
	   (string-append "REPLY "
			  (substring cmd 5 (string-length cmd)))
	    outport)
	  (loop))
	 ((strncmp "INFO" cmd 4)
	  (write-line (string-append "YOUR_IP "
				     (socket-address->string client-addr))
		      outport)
	  (loop))
	 ((strncmp "MLECHO " cmd 7)
	  (let* ((c (substring cmd 7 8))
		 (n (string->number c))
		 (lines (map (lambda (i) (read-line inport))
			     (iota n))))
	    (write-line (string-append "MLREPLY " c) outport)
	    (for-each (lambda (s) (write-line s outport))
		      lines)
	    (loop)))
	 ((strncmp "QUIT" cmd 4) #t)
	 (else
	  (write-string "ERROR Unknown Command\n")
	  (loop))))))
  (close-socket socket))

(define (server-loop socket)
  (call-with-values
   (lambda () (accept-connection socket))
   client-loop)
  (server-loop socket))

(define (start)
  (let ((socket (create-socket protocol-family/internet socket-type/stream)))
    (bind-socket socket
		 (internet-address->socket-address internet-address/any
						   9000))
    (listen-socket socket 5)
    (server-loop socket)
    (close-socket socket)))

(start)