;; mzsocket: BSD/POSIX sockets library for PLT-scheme
;; examples
;;
;; (C) Copyright 2007,2008 Dimitris Vyzovitis <vyzo at media.mit.edu>
;;
;; mzsocket 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 3 of the License, or
;; (at your option) any later version.
;;
;; mzsocket 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 mzsocket.  If not, see <http://www.gnu.org/licenses/>.

#lang scheme/base

(require "main.ss"
         net/url net/dns 
         scheme/port)

(provide (all-defined-out))

(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-recv-evt sock)
        (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-recv-evt sock)
        (lambda (x)
          (let-values (((ilen peer) (socket-recvfrom sock buf))) peer))))))