Changeset 14316 in project


Ignore:
Timestamp:
04/20/09 18:24:03 (11 years ago)
Author:
Alex Shinn
Message:

udp for chicken 4

Location:
release/4/udp
Files:
3 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/udp/udp.meta

    r8876 r14316  
    11;;; udp.meta -*- Hen -*-
    22((egg "udp.egg")
    3  (date "2004-03-24")
    43 (files "udp.scm" "udp.setup" "udp.html")
    54 (synopsis "An interface to User Datagram Protocol sockets")
  • release/4/udp/udp.scm

    r293 r14316  
    5353
    5454(declare
    55 ; (unit udp)
    56  (uses extras srfi-18)
    57  (usual-integrations)
    5855 (fixnum-arithmetic)
    5956 (no-bound-checks)
    60  (export io:event-dispatch io:descriptor io:read-handler io:write-handler
    61          io:exception-handler io:set-read-handler! io:set-write-handler!
    62          io:set-exception-handler!
    63          udp-socket? udp-bound? udp-connected? udp-open-socket
    64          udp-open-socket* udp-bind! udp-connect! udp-send udp-sendto
    65          udp-recv udp-recvfrom udp-close-socket udp-bound-port
    66          udp-set-multicast-interface udp-join-multicast-group)
    67  (bound-to-procedure
    68   ##net#socket ##net#bind ##net#connect ##net#close ##net#recv ##net#recvfrom
    69   ##net#send ##net#sendto ##net#select ##net#gethostaddr ##sys#update-errno
    70   ##sys#error ##sys#signal-hook ##net#make-nonblocking ##net#hstrerror
    71   ##net#inaddr->string ##net#inaddr-port ##net#error ##net#herror
    72   ##net#get-host-or-error syscall-failed?
    73   ##io#select))
     57 )
    7458
    7559(register-feature! 'udp)
    7660
    77 (cond-expand
    78  [unsafe
    79   (eval-when (compile)
    80              (define-macro (##sys#check-structure x y) '(##core#undefined))
    81              (define-macro (##sys#check-range x y z) '(##core#undefined))
    82              (define-macro (##sys#check-pair x) '(##core#undefined))
    83              (define-macro (##sys#check-list x) '(##core#undefined))
    84              (define-macro (##sys#check-symbol x) '(##core#undefined))
    85              (define-macro (##sys#check-string x) '(##core#undefined))
    86              (define-macro (##sys#check-char x) '(##core#undefined))
    87              (define-macro (##sys#check-exact x) '(##core#undefined))
    88              (define-macro (##sys#check-port x) '(##core#undefined))
    89              (define-macro (##sys#check-number x) '(##core#undefined))
    90              (define-macro (##sys#check-byte-vector x) '(##core#undefined)))]
    91  [else])
    92 
     61(module udp
     62  (io:event-dispatch io:descriptor io:read-handler io:write-handler
     63   io:exception-handler io:set-read-handler! io:set-write-handler!
     64   io:set-exception-handler!
     65   udp-socket? udp-bound? udp-connected? udp-open-socket
     66   udp-open-socket* udp-bind! udp-connect! udp-send udp-sendto
     67   udp-recv udp-recvfrom udp-close-socket udp-bound-port
     68   udp-set-multicast-interface udp-join-multicast-group)
     69
     70(import scheme chicken extras foreign srfi-1 srfi-18)
    9371
    9472;;; ------- copied from tcp.scm, more or less -------
     
    163141(define-foreign-variable _ewouldblock int "EWOULDBLOCK")
    164142
    165 (define ##net#socket (foreign-lambda int "socket" int int int))
    166 (define ##net#bind (foreign-lambda int "bind" int pointer int))
    167 (define ##net#close (foreign-lambda int "closesocket" int))
    168 (define ##net#send (foreign-lambda int "send" int pointer int int))
    169 (define ##net#sendto (foreign-lambda int "sendto" int pointer int int pointer int))
    170 (define ##net#recv (foreign-lambda int "recv" int pointer int int))
    171 (define ##net#recvfrom (foreign-lambda int "recvfrom" int pointer int int pointer c-pointer))
    172 (define ##net#connect (foreign-lambda int "connect" int pointer int))
    173 
    174 (define ##net#make-nonblocking
     143(define net-socket (foreign-lambda int "socket" int int int))
     144(define net-bind (foreign-lambda int "bind" int pointer int))
     145(define net-close (foreign-lambda int "closesocket" int))
     146(define net-send (foreign-lambda int "send" int pointer int int))
     147(define net-sendto (foreign-lambda int "sendto" int pointer int int pointer int))
     148(define net-recv (foreign-lambda int "recv" int pointer int int))
     149(define net-recvfrom (foreign-lambda int "recvfrom" int pointer int int pointer c-pointer))
     150(define net-connect (foreign-lambda int "connect" int pointer int))
     151
     152(define net-make-nonblocking
    175153  (foreign-lambda* bool ([int fd])
    176154#<<EOF
     
    192170))
    193171
    194 (define ##net#getsockport
     172(define net-getsockport
    195173  (foreign-lambda* int ([int s])
    196174    "struct sockaddr_in sa;"
     
    199177    "else return(ntohs(sa.sin_port));") )
    200178
    201 (define ##net#gethostaddr
     179(define net-gethostaddr
    202180  (foreign-lambda* bool ((pointer saddr) (c-string host) (unsigned-short port))
    203181    "struct hostent *he = gethostbyname(host);"
     
    210188    "return(1);"))
    211189
    212 (define ##net#startup
     190(define net-startup
    213191  (foreign-lambda* bool () #<<EOF
    214192#ifdef _WIN32
     
    221199) )
    222200
    223 (unless (##net#startup)
     201(unless (net-startup)
    224202  (##sys#signal-hook #:network-error "can not initialize Winsock") )
    225203;;; ------- end of code from tcp.scm -------
    226204
    227 (define ##net#hstrerror (foreign-lambda c-string "hstrerror" int))
    228 
    229 ;;; ##io#select : fd-vec fd-vec fd-vec timeout-secs timeout-usecs -> int
     205(define net-hstrerror (foreign-lambda c-string "hstrerror" int))
     206
     207;;; io-select : fd-vec fd-vec fd-vec timeout-secs timeout-usecs -> int
    230208;;; take three vectors of fds we want to read from, write from, and
    231209;;; handle exceptional events from, plus a timeout in seconds+microseconds,
     
    233211;;; event didn't occur, otherwise leave them set to the fd number so we can
    234212;;; reverse-map the fds back to their socket container structures later.
    235 (define ##io#select
     213(define io-select
    236214  (foreign-lambda* int ((scheme-object rv)
    237215                        (scheme-object wv)
     
    303281))
    304282
    305 ;;; ##net#make-in-addr-any-addr : sockaddr-in-pointer port -> bool
     283;;; net-make-in-addr-any-addr : sockaddr-in-pointer port -> bool
    306284;;; make a sockaddr_in structure with the address set to INADDR_ANY
    307285;;; and the specified port.
    308 (define ##net#make-in-addr-any-addr
     286(define net-make-in-addr-any-addr
    309287  (foreign-lambda* bool ((pointer saddr) (int port))
    310288#<<EOF
     
    318296))
    319297
    320 ;;; ##net#inaddr->string : sockaddr-in-pointer -> c-string
     298;;; net-inaddr->string : sockaddr-in-pointer -> c-string
    321299;;; Use inet_ntop(3) to turn a sockaddr_in address into a string.
    322 (define ##net#inaddr->string
     300(define net-inaddr->string
    323301  (foreign-lambda* c-string ((pointer saddr))
    324302#<<EOF
     
    330308EOF
    331309))
    332 ;;; ##net#inaddr-port : sockaddr-in-pointer -> int
     310;;; net-inaddr-port : sockaddr-in-pointer -> int
    333311;;; return the port number of a sockaddr_in structure.
    334 (define ##net#inaddr-port
     312(define net-inaddr-port
    335313  (foreign-lambda* int ((pointer saddr))
    336314#<<EOF
     
    342320
    343321;;; error-signaling calls
    344 (define ##net#error
     322(define net-error
    345323  (lambda args
    346324    (##sys#update-errno)
    347325    (apply ##sys#signal-hook #:network-error args)))
    348 (define ##net#herror
     326(define net-herror
    349327  (lambda (host)
    350     (##net#error "hostname lookup failed" host (##net#hstrerror h_errno))))
    351 (define ##net#get-host-or-error
     328    (net-error "hostname lookup failed" host (net-hstrerror h_errno))))
     329(define net-get-host-or-error
    352330  (lambda (sa host port)
    353     (if (not (##net#gethostaddr sa host port))
    354         (##net#herror host))))
     331    (if (not (net-gethostaddr sa host port))
     332        (net-herror host))))
    355333
    356334(define syscall-failed?
     
    368346             (yield)
    369347             (restart-nonblocking name fd i/o thunk))
    370             (else (##net#error error-message name))))))
     348            (else (net-error error-message name))))))
    371349
    372350(define (yield)
     
    378356
    379357;;; io:event-dispatch : slist timeout-secs timeout-usecs -> bool
    380 ;;; high-level interface to ##io#select - take a list of descriptors
     358;;; high-level interface to io-select - take a list of descriptors
    381359;;; packaged in records that have, among other things, slots for read,
    382360;;; write, and exception handler callback procedures.  Extract the
    383 ;;; fd numbers we want to handle events from, call ##io#select, and
     361;;; fd numbers we want to handle events from, call io-select, and
    384362;;; use the results to run the handlers for the events that occurred.
    385363(define io:event-dispatch
     
    396374               (wv (list->vector (map car writers)))
    397375               (ev (list->vector (map car cepters))))
    398            (let ((ret (##io#select rv wv ev timeout-secs timeout-usecs)))
    399              (cond ((syscall-failed? ret) (##net#error "select"))
     376           (let ((ret (io-select rv wv ev timeout-secs timeout-usecs)))
     377             (cond ((syscall-failed? ret) (net-error "select"))
    400378                   ((fx= ret 0) (and (procedure? timeout-handler)
    401379                                   (timeout-handler slist)))
     
    426404(define udp-open-socket
    427405  (lambda ()
    428     (let ((s (##net#socket _af_inet _sock_dgram 0)))
     406    (let ((s (net-socket _af_inet _sock_dgram 0)))
    429407      (if (syscall-failed? s)
    430           (##net#error "socket")
     408          (net-error "socket")
    431409          (##sys#make-structure 'udp-socket s #f #f #f #f #f)))))
    432410
     
    444422  (lambda ()
    445423    (let ((s (udp-open-socket)))
    446       (and (udp-socket? s) (##net#make-nonblocking (io:descriptor s)) s))))
     424      (and (udp-socket? s) (net-make-nonblocking (io:descriptor s)) s))))
    447425;;; udp-bind! : udp-socket host-string port-number -> unspecified
    448426;;; bind a socket to a local address (possibly INADDR_ANY) and port
     
    452430          (addr (make-string _sockaddr_in_size)))
    453431      (if host
    454           (##net#get-host-or-error addr host port)
    455           (##net#make-in-addr-any-addr addr port))
    456       (if (syscall-failed? (##net#bind fd addr _sockaddr_in_size))
    457           (##net#error "bind" host port)
     432          (net-get-host-or-error addr host port)
     433          (net-make-in-addr-any-addr addr port))
     434      (if (syscall-failed? (net-bind fd addr _sockaddr_in_size))
     435          (net-error "bind" host port)
    458436          (##sys#setslot sock 2 #t)))))
    459437
     
    461439  (lambda (sock)
    462440    (let* ([fd (io:descriptor sock)]
    463            [port (##net#getsockport fd)])
     441           [port (net-getsockport fd)])
    464442      (if (eq? -1 port)
    465         (##net#error "getsockport"))
     443        (net-error "getsockport"))
    466444      port)))
    467445
     
    474452    (let ((fd (io:descriptor sock))
    475453          (addr (make-string _sockaddr_in_size)))
    476       (##net#get-host-or-error addr host port)
    477       (if (syscall-failed? (##net#connect fd addr _sockaddr_in_size))
    478           (##net#error "connect" host port)
     454      (net-get-host-or-error addr host port)
     455      (if (syscall-failed? (net-connect fd addr _sockaddr_in_size))
     456          (net-error "connect" host port)
    479457          (##sys#setslot sock 3 #t)))))
    480458
     
    488466      (restart-nonblocking "send" fd #f
    489467       (lambda ()
    490          (##net#send fd str (string-length str) 0))))))
     468         (net-send fd str (string-length str) 0))))))
    491469
    492470;;; udp-sendto : udp-socket host-string port-num string -> unspecified
     
    496474    (let ((fd (io:descriptor sock))
    497475          (addr (make-string _sockaddr_in_size)))
    498       (##net#get-host-or-error addr host port)
     476      (net-get-host-or-error addr host port)
    499477      (restart-nonblocking "sendto" fd #f
    500         (lambda () (##net#sendto fd str (string-length str)
     478        (lambda () (net-sendto fd str (string-length str)
    501479                                 0 addr _sockaddr_in_size))))))
    502480                         
     
    510488      (let ((result
    511489             (restart-nonblocking "recv" fd #t
    512                (lambda () (##net#recv fd buf len 0)))))
     490               (lambda () (net-recv fd buf len 0)))))
    513491          (values result (substring buf 0 result))))))
    514492
     
    525503        (let ((result
    526504               (restart-nonblocking "recvfrom" fd #t
    527                                     (lambda () (##net#recvfrom fd buf len
     505                                    (lambda () (net-recvfrom fd buf len
    528506                                                               0 from #$fromlen)))))
    529507          (values result (substring buf 0 result)
    530                   (##net#inaddr->string from) (##net#inaddr-port from)))))) )
     508                  (net-inaddr->string from) (net-inaddr-port from)))))) )
    531509
    532510;;; udp-close-socket : udp-socket -> bool
     
    535513  (lambda (sock)
    536514    (let ((fd (io:descriptor sock)))
    537       (if (syscall-failed? (##net#close fd)) #f #t))))
     515      (if (syscall-failed? (net-close fd)) #f #t))))
    538516
    539517;;; multicast
    540 (define ##net#set-multicast-interface
     518(define net-set-multicast-interface
    541519  (foreign-lambda* bool ((int s) (c-string host))
    542520#<<EOF
     
    554532  (lambda (sock interface-host)
    555533    (let ([fd (io:descriptor sock)])
    556       (or (##net#set-multicast-interface fd interface-host)
    557           (##net#error "udp-set-multicast-interface" error-message)))))
    558 
    559 (define ##net#join-multicast-group
     534      (or (net-set-multicast-interface fd interface-host)
     535          (net-error "udp-set-multicast-interface" error-message)))))
     536
     537(define net-join-multicast-group
    560538  (foreign-lambda* bool ((int s) (c-string ihost) (c-string mhost) (bool join))
    561539#<<EOF
     
    580558  (lambda (sock interface-host multicast-host . opt)
    581559    (let ([fd (io:descriptor sock)]
    582           [join (:optional opt #t)])
    583       (or (##net#join-multicast-group fd interface-host multicast-host join)
    584           (##net#error "udp-join-multicast-group" error-message)))))
     560          [join (and (pair? opt) (car opt))])
     561      (or (net-join-multicast-group fd interface-host multicast-host join)
     562          (net-error "udp-join-multicast-group" error-message)))))
     563
     564)
    585565
    586566;;; END
  • release/4/udp/udp.setup

    r295 r14316  
    1 (switch (software-type)
    2         ['windows (compile udp.scm -O2 -d1 -s -lws2_32)]
    3         [else (compile udp.scm -O2 -d1 -s)])
    4        
    5 (install-extension 'udp '("udp.so" "udp.html") '((version 1.12) (documentation "udp.html")))
     1
     2(case (software-type)
     3  ((windows) (compile -O2 -d1 -s -j udp udp.scm -lws2_32))
     4  (else (compile -O2 -d1 -s -j udp udp.scm)))
     5
     6(compile -O2 -d0 -s udp.import.scm)
     7
     8(install-extension
     9 'udp
     10 '("udp.so" "udp.import.so" "udp.html")
     11 '((version 1.13)
     12   (documentation "udp.html")))
Note: See TracChangeset for help on using the changeset viewer.