reformatting

svn: r9853

original commit: 0d41afdb6d

collects/net/cgi.ss

@@ -1,6 +1,6 @@
-(module cgi mzscheme
+#lang scheme/base
-  (require mzlib/unit "cgi-sig.ss" "cgi-unit.ss")
+(require scheme/unit "cgi-sig.ss" "cgi-unit.ss")
 
 (define-values/invoke-unit/infer cgi@)
 
-  (provide-signature-elements cgi^))
+(provide-signature-elements cgi^)

collects/net/cookie.ss

@@ -1,6 +1,6 @@
-(module cookie mzscheme
+#lang scheme/base
-  (require mzlib/unit "cookie-sig.ss" "cookie-unit.ss")
+(require scheme/unit "cookie-sig.ss" "cookie-unit.ss")
 
 (provide-signature-elements cookie^)
 
-  (define-values/invoke-unit/infer cookie@))
+(define-values/invoke-unit/infer cookie@)

collects/net/dns.ss

@@ -1,6 +1,6 @@
-(module dns mzscheme
+#lang scheme/base
-  (require mzlib/unit "dns-sig.ss" "dns-unit.ss")
+(require scheme/unit "dns-sig.ss" "dns-unit.ss")
 
 (define-values/invoke-unit/infer dns@)
 
-  (provide-signature-elements dns^))
+(provide-signature-elements dns^)

collects/net/ftp.ss

@@ -1,6 +1,6 @@
-(module ftp mzscheme
+#lang scheme/base
-  (require mzlib/unit "ftp-sig.ss" "ftp-unit.ss")
+(require scheme/unit "ftp-sig.ss" "ftp-unit.ss")
 
 (define-values/invoke-unit/infer ftp@)
 
-  (provide-signature-elements ftp^))
+(provide-signature-elements ftp^)

collects/net/imap.ss

@@ -1,5 +1,5 @@
-(module imap mzscheme
+#lang scheme/base
-  (require mzlib/unit mzlib/contract "imap-sig.ss" "imap-unit.ss")
+(require scheme/unit scheme/contract "imap-sig.ss" "imap-unit.ss")
 
 (define-values/invoke-unit/infer imap@)
 
@@ -7,7 +7,8 @@
  [imap-get-hierarchy-delimiter (imap-connection? . -> . bytes?)]
  [imap-list-child-mailboxes
   (case->
-     (imap-connection? (or/c false/c bytes?) . -> . (listof (list/c (listof symbol?) bytes?)))
+   (imap-connection? (or/c false/c bytes?)
+                     . -> . (listof (list/c (listof symbol?) bytes?)))
    (imap-connection? (or/c false/c bytes?) (or/c false/c bytes?)
                      . -> .
                      (listof (list/c (listof symbol?) bytes?))))])
@@ -46,4 +47,4 @@
  imap-mailbox-exists?
  imap-create-mailbox
 
-   imap-mailbox-flags))
+ imap-mailbox-flags)

collects/net/mime-util.ss

@@ -26,8 +26,7 @@
 ;;
 ;; Commentary:
 
-(module mime-util mzscheme
+#lang scheme/base
-  (require mzlib/etc)
 
 (provide string-tokenizer
          trim-all-spaces
@@ -52,8 +51,7 @@
     (if (string=? s "") '()
         (let ([i (string-index s c)])
           (if i (cons (substring s 0 i)
-                        (loop (substring s (+ i 1)
+                      (loop (substring s (+ i 1) (string-length s))))
-                                         (string-length s))))
               (list s))))))
 
 ;; Trim all spaces, except those in quoted strings.
@@ -129,13 +127,10 @@
 
 ;; Copies its input `in' to its ouput port if given, it uses
 ;; current-output-port if out is not provided.
-  (define cat
+(define (cat in [out (current-output-port)])
-    (opt-lambda (in (out (current-output-port)))
   (let loop ([ln (read-line in)])
     (unless (eof-object? ln)
       (fprintf out "~a\n" ln)
-          (loop (read-line in))))))
+      (loop (read-line in)))))
-
-  )
 
 ;;; mime-util.ss ends here

collects/net/mime.ss

@@ -26,8 +26,8 @@
 ;;
 ;; Commentary:
 
-(module mime mzscheme
+#lang scheme/base
-  (require mzlib/unit
+(require scheme/unit
          "mime-sig.ss"
          "mime-unit.ss"
          "qp-sig.ss"
@@ -46,6 +46,6 @@
 
 (define-values/invoke-unit/infer mime@2)
 
-  (provide-signature-elements mime^))
+(provide-signature-elements mime^)
 
 ;;; mime.ss ends here

collects/net/nntp.ss

@@ -1,6 +1,6 @@
-(module nntp mzscheme
+#lang scheme/base
-  (require mzlib/unit "nntp-sig.ss" "nntp-unit.ss")
+(require scheme/unit "nntp-sig.ss" "nntp-unit.ss")
 
 (define-values/invoke-unit/infer nntp@)
 
-  (provide-signature-elements nntp^))
+(provide-signature-elements nntp^)

collects/net/pop3.ss

@@ -1,9 +1,9 @@
-(module pop3 mzscheme
+#lang scheme/base
-  (require mzlib/unit "pop3-sig.ss" "pop3-unit.ss")
+(require scheme/unit "pop3-sig.ss" "pop3-unit.ss")
 
 (define-values/invoke-unit/infer pop3@)
 
-  (provide-signature-elements pop3^))
+(provide-signature-elements pop3^)
 
 #|
 

collects/net/qp.ss

@@ -26,11 +26,11 @@
 ;;
 ;; Commentary:
 
-(module qp mzscheme
+#lang scheme/base
 (require mzlib/unit "qp-sig.ss" "qp-unit.ss")
 
 (define-values/invoke-unit/infer qp@)
 
-  (provide-signature-elements qp^))
+(provide-signature-elements qp^)
 
 ;;; qp.ss ends here

collects/net/sendmail.ss

@@ -1,6 +1,6 @@
-(module sendmail mzscheme
+#lang scheme/base
-  (require mzlib/unit "sendmail-sig.ss" "sendmail-unit.ss")
+(require scheme/unit "sendmail-sig.ss" "sendmail-unit.ss")
 
 (define-values/invoke-unit/infer sendmail@)
 
-  (provide-signature-elements sendmail^))
+(provide-signature-elements sendmail^)

collects/net/smtp.ss

@@ -1,6 +1,6 @@
-(module smtp mzscheme
+#lang scheme/base
-  (require mzlib/unit "smtp-sig.ss" "smtp-unit.ss")
+(require scheme/unit "smtp-sig.ss" "smtp-unit.ss")
 
 (define-values/invoke-unit/infer smtp@)
 
-  (provide-signature-elements smtp^))
+(provide-signature-elements smtp^)

collects/net/ssl-tcp-unit.ss

@@ -1,9 +1,8 @@
-(module ssl-tcp-unit mzscheme
+#lang scheme/base
 (provide make-ssl-tcp@)
-  (require mzlib/unit
+(require scheme/unit
          "tcp-sig.ss"
-           (lib "mzssl.ss" "openssl")
+         openssl/mzssl)
-           mzlib/etc)
 
 (define (make-ssl-tcp@
          server-cert-file server-key-file server-root-cert-files server-suggest-auth-file
@@ -37,15 +36,12 @@
 
    (define tcp-addresses ssl-addresses)
    (define tcp-close ssl-close)
-     (define tcp-connect
+   (define (tcp-connect hostname port-k)
-       (opt-lambda (hostname port-k)
+     (ssl-connect hostname port-k ctx))
-         (ssl-connect hostname port-k ctx)))
+   (define (tcp-connect/enable-break hostname port-k)
-     (define tcp-connect/enable-break
+     (ssl-connect/enable-break hostname port-k ctx))
-       (opt-lambda (hostname port-k)
-         (ssl-connect/enable-break hostname port-k ctx)))
 
-     (define tcp-listen
+   (define (tcp-listen port [allow-k 4] [reuse? #f] [hostname #f])
-       (opt-lambda (port [allow-k 4] [reuse? #f] [hostname #f])
      (let ([l (ssl-listen port allow-k reuse? hostname)])
        (when server-cert-file
          (ssl-load-certificate-chain! l server-cert-file))
@@ -58,6 +54,6 @@
               server-root-cert-files))
        (when server-suggest-auth-file
          (ssl-load-suggested-certificate-authorities! l server-suggest-auth-file))
-           l)))
+       l))
 
-     (define tcp-listener? ssl-listener?))))
+   (define tcp-listener? ssl-listener?)))

collects/net/tcp-redirect.ss

@@ -1,9 +1,9 @@
-(module tcp-redirect mzscheme
+#lang scheme/base
 (provide tcp-redirect)
 
-  (require mzlib/unit
+(require scheme/unit
-           mzlib/async-channel
+         scheme/tcp
-           mzlib/etc
+         scheme/async-channel
          "tcp-sig.ss")
 
 (define raw:tcp-abandon-port tcp-abandon-port)
@@ -17,25 +17,24 @@
 (define raw:tcp-listen tcp-listen)
 (define raw:tcp-listener? tcp-listener?)
 
-  ; For tcp-listeners, we use an else branch in the conds since
+;; For tcp-listeners, we use an else branch in the conds since
-  ; (instead of a contract) I want the same error message as the raw
+;; (instead of a contract) I want the same error message as the raw
-  ; primitive for bad inputs.
+;; primitive for bad inputs.
 
-  ; : (listof nat) -> (unit/sig () -> net:tcp^)
+;; : (listof nat) -> (unit/sig () -> net:tcp^)
-  (define tcp-redirect
+(define (tcp-redirect redirected-ports [redirected-address "127.0.0.1"])
-    (opt-lambda (redirected-ports [redirected-address "127.0.0.1"])
   (unit
    (import)
    (export tcp^)
-        ; : (make-pipe-listener nat (channel (cons iport oport)))
+   ;; : (make-pipe-listener nat (channel (cons iport oport)))
    (define-struct pipe-listener (port channel))
 
-        ; : port -> void
+   ;; : port -> void
    (define (tcp-abandon-port tcp-port)
      (when (tcp-port? tcp-port)
        (raw:tcp-abandon-port tcp-port)))
 
-        ; : listener -> iport oport
+   ;; : listener -> iport oport
    (define (tcp-accept tcp-listener)
      (cond
        [(pipe-listener? tcp-listener)
@@ -43,11 +42,11 @@
           (values (car in-out) (cdr in-out)))]
        [else (raw:tcp-accept tcp-listener)]))
 
-        ; : listener -> iport oport
+   ;; : listener -> iport oport
    (define (tcp-accept/enable-break tcp-listener)
      (cond
        [(pipe-listener? tcp-listener)
-             ; XXX put this into async-channel.ss as async-channel-get/enable-break
+        ;; XXX put this into async-channel.ss as async-channel-get/enable-break
         (sync/enable-break
          (handle-evt
           (pipe-listener-channel tcp-listener)
@@ -57,28 +56,26 @@
            (values (car in-out) (cdr in-out)))
        [else (raw:tcp-accept/enable-break tcp-listener)]))
 
-        ; : tcp-listener -> iport oport
+   ;; : tcp-listener -> iport oport
-        ; FIX - check channel queue size
+   ;; FIX - check channel queue size
    (define (tcp-accept-ready? tcp-listener)
      (cond
        [(pipe-listener? tcp-listener) #t]
        [else (raw:tcp-accept-ready? tcp-listener)]))
 
-        ; : tcp-port -> str str
+   ;; : tcp-port -> str str
    (define (tcp-addresses tcp-port)
      (if (tcp-port? tcp-port)
        (raw:tcp-addresses tcp-port)
        (values redirected-address redirected-address)))
 
-        ; : port -> void
+   ;; : port -> void
    (define (tcp-close tcp-listener)
      (if (tcp-listener? tcp-listener)
        (raw:tcp-close tcp-listener)
-              (hash-table-remove!
+       (hash-remove! port-table (pipe-listener-port tcp-listener))))
-               port-table
-               (pipe-listener-port tcp-listener))))
 
-        ; : (str nat -> iport oport) -> str nat -> iport oport
+   ;; : (str nat -> iport oport) -> str nat -> iport oport
    (define (gen-tcp-connect raw)
      (lambda (hostname-string port)
        (if (and (string=? redirected-address hostname-string)
@@ -87,9 +84,7 @@
                       [(from-in to-out) (make-pipe)])
            (async-channel-put
             (pipe-listener-channel
-                    (hash-table-get
+             (hash-ref port-table port
-                     port-table
-                     port
                        (lambda ()
                          (raise (make-exn:fail:network
                                  (format "tcp-connect: connection to ~a, port ~a failed (nobody is listening)"
@@ -99,40 +94,40 @@
            (values from-in from-out))
          (raw hostname-string port))))
 
-        ; : str nat -> iport oport
+   ;; : str nat -> iport oport
    (define tcp-connect (gen-tcp-connect raw:tcp-connect))
 
-        ; : str nat -> iport oport
+   ;; : str nat -> iport oport
-        (define tcp-connect/enable-break (gen-tcp-connect raw:tcp-connect/enable-break))
+   (define tcp-connect/enable-break
+     (gen-tcp-connect raw:tcp-connect/enable-break))
 
-        ; FIX - support the reuse? flag.
+   ;; FIX - support the reuse? flag.
-        (define tcp-listen
+   (define (tcp-listen port [max-allow-wait 4] [reuse? #f] [hostname-string #f])
-          (opt-lambda (port [max-allow-wait 4] [reuse? #f] [hostname-string #f])
+     (hash-ref port-table port
-            (hash-table-get
-             port-table
-             port
        (lambda ()
          (if (redirect? port)
            (let ([listener (make-pipe-listener port (make-async-channel))])
-                     (hash-table-put! port-table port listener)
+             (hash-set! port-table port listener)
              listener)
-                   (raw:tcp-listen port max-allow-wait reuse? hostname-string))))))
+           (raw:tcp-listen port max-allow-wait reuse? hostname-string)))))
 
-        ; : tst -> bool
+   ;; : tst -> bool
    (define (tcp-listener? x)
      (or (pipe-listener? x) (raw:tcp-listener? x)))
 
-        ; ---------- private ----------
+   ;; ---------- private ----------
 
-        ; : (hash-table nat[port] -> tcp-listener)
+   ;; : (hash nat[port] -> tcp-listener)
-        (define port-table (make-hash-table))
+   (define port-table (make-hasheq))
 
    (define redirect-table
-          (let ([table (make-hash-table)])
+     (let ([table (make-hasheq)])
-            (for-each (lambda (x) (hash-table-put! table x #t))
+       (for-each (lambda (x) (hash-set! table x #t))
                  redirected-ports)
        table))
 
-        ; : nat -> bool
+   ;; : nat -> bool
    (define (redirect? port)
-          (hash-table-get redirect-table port (lambda () #f)))))))
+     (hash-ref redirect-table port #f))
+
+   ))

collects/net/tcp-unit.ss

@@ -1,6 +1,6 @@
-(module tcp-unit mzscheme
+#lang scheme/base
 (provide tcp@)
 
-  (require mzlib/unit "tcp-sig.ss")
+(require scheme/unit scheme/tcp "tcp-sig.ss")
 
-  (define-unit-from-context tcp@ tcp^))
+(define-unit-from-context tcp@ tcp^)

collects/net/unihead.ss

@@ -1,4 +1,4 @@
-(module unihead mzscheme
+#lang mzscheme
 (require net/base64
          net/qp
          mzlib/string)
@@ -115,4 +115,4 @@
                          (subbytes rest 3)
                          rest)])
                   (decode-for-header (bytes->string/latin-1 rest))))))
-             s)))))
+           s))))