;; 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 examples mzscheme
  (require "socket.ss")
  (require (lib "url.ss" "net")
           (lib "dns.ss" "net")
           (lib "port.ss"))

  (provide (all-defined))
  (define (url->request url)
    (string->bytes/utf-8 (format "GET ~a HTTP/1.0\r\n\r\n" (url->string url))))
  
  (define (get-url what)
    (let* ((url (string->url what))
           (host (dns-get-address (dns-find-nameserver) (url-host url)))
           (port (or (url-port url) 80))
           (sock (socket)))
      (socket-connect sock (inet4-address host port))
      (socket-send-all sock (url->request url))
      (socket-shutdown sock SHUT_WR)
      (socket-recv/port sock (current-output-port))
      (socket-close sock)))

  (define (get-url/stream what)
    (let* ((url (string->url what))
           (host (dns-get-address (dns-find-nameserver) (url-host url)))
           (port (or (url-port url) 80)))
      (let-values (((inp outp) (open-socket-stream (inet4-address host port))))
        (write-bytes (url->request url) outp)
        (close-output-port outp)
        (copy-port inp (current-output-port)))))

  (define (echo sock addr)
    (let ((buf (make-bytes 4096)))
      (let lp ()
        (let ((ilen (socket-recv sock buf)))
          (unless (= ilen 0)
            (socket-send-all sock buf 0 ilen)
            (lp)))))
    (socket-close sock))

  (define (echo-server domain addr)
    (let ((sock (socket domain SOCK_STREAM)))
      (socket-setsockopt sock SOL_SOCKET SO_REUSEADDR #t)
      (socket-bind sock addr)
      (socket-listen sock 5)
      (let lp ()
        (let-values (((clisock cliaddr) (socket-accept sock)))
          (thread (lambda () (echo clisock cliaddr)))
          (lp)))))

  (define (udp-echo-server port)
    (let ((sock (socket PF_INET SOCK_DGRAM))
          (buf (make-bytes 1500)))
      (socket-setsockopt sock SOL_SOCKET SO_REUSEADDR #t)
      ;; receive broadcasts too
      (socket-setsockopt sock SOL_SOCKET SO_BROADCAST #t)
      (socket-bind sock (inet4-address INADDR_ANY port))
      (let lp ()
        (let-values (((ilen peer) (socket-recvfrom sock buf)))
          (socket-sendto sock peer buf 0 ilen)
          (lp)))))

  (define (udp-echo-sendto dest timeout msg)
    (let* ((sock (socket PF_INET SOCK_DGRAM))
           (buf (make-bytes (bytes-length msg))))
      (socket-sendto sock dest msg)
      (sync/timeout timeout
        (handle-evt (socket-evt sock socket-evt:read)
          (lambda x 
            (let-values (((ilen peer) (socket-recvfrom sock buf)))
              (values peer buf)))))))

  (define (udp-echo-find port timeout)
    (let* ((sock (socket PF_INET SOCK_DGRAM))
           (buf (make-bytes 8)))
      (socket-setsockopt sock SOL_SOCKET SO_BROADCAST #t)
      (socket-sendto sock (inet4-address INADDR_BROADCAST port) #"hello")
      (sync/timeout timeout
        (handle-evt (socket-evt sock socket-evt:read)
          (lambda x 
            (let-values (((ilen peer) (socket-recvfrom sock buf))) peer))))))
  )