#lang racket
(require racket/cmdline
         racket/unit
         net/tcp-sig
         net/tcp-unit
         net/ssl-tcp-unit)
(require web-server/configuration/configuration-table
         (except-in web-server/web-server serve)
         web-server/web-config-unit)

; this is used by launchers
; extract-flag : sym (listof (cons sym alpha)) alpha -> alpha
(define (extract-flag name flags default)
  (let ([x (assq name flags)])
    (if x
        (cdr x)
        default)))

(define ssl (make-parameter #f))
(define port (make-parameter #f))

(define configuration@
  (parse-command-line
   "plt-web-server"
   (current-command-line-arguments)
   `((once-each
      [("--ssl")
       ,(lambda (flag)
          (unless (port) (port 443))
          (ssl #t))
       ("Run with SSL using server-cert.pem and private-key.pem in the current directory, with 443 as the default port.")]
      [("-f" "--configuration-table")
       ,(lambda (flag file-name)
          (cond
            [(not (file-exists? file-name))
             (error 'web-server "configuration file ~s not found" file-name)]
            [(not (memq 'read (file-or-directory-permissions file-name)))
             (error 'web-server "configuration file ~s is not readable" file-name)]
            [else (cons 'config (string->path file-name))]))
       ("Use an alternate configuration table" "file-name")]
      [("-p" "--port")
       ,(lambda (flag the-port)
          (let ([p (string->number the-port)])
            (if (and (integer? p) (<= 1 p 65535))
              (port p)
              (error 'web-server "expecting a valid port number, got \"~a\"" the-port))))
       ("Use an alternate network port." "port")]
      [("-a" "--ip-address")
       ,(lambda (flag ip-address)
          ; note the double backslash I initially left out.  That's a good reason to use Olin's regexps.
          (let ([addr (regexp-split #px"\\." ip-address)])
            (if (and (= 4 (length addr))
                     (andmap (lambda (s)
                               (let ([n (string->number s)])
                                 (and (integer? n) (<= 0 n 255))))
                             addr))
                (cons 'ip-address ip-address)
                (error 'web-server "ip-address expects a numeric ip-address (i.e. 127.0.0.1); given ~s" ip-address))))
       ("Restrict access to come from ip-address" "ip-address")]))
   (lambda (flags)
     (configuration-table->web-config@
      (extract-flag 'config flags default-configuration-table-path)
      #:port (port)
      #:listen-ip (extract-flag 'ip-address flags #f)))
   '()))

(define (serve)
  (serve/web-config@ 
   configuration@
   #:tcp@ (if (ssl)
              (let ()
                (define-unit-binding ssl-tcp@
                  (make-ssl-tcp@ (build-path (current-directory) "server-cert.pem")
                                 (build-path (current-directory) "private-key.pem")
                                 #f #f #f #f #f)
                  (import) (export tcp^))
                ssl-tcp@)
              tcp@)))

(provide serve)
