diff --git a/scsh/network.scm b/scsh/network.scm index d3a8f89..3af8b85 100644 --- a/scsh/network.scm +++ b/scsh/network.scm @@ -37,13 +37,16 @@ (service-info:port (service-info (cadr args) "tcp"))) (else - (error "socket-connect: bad arg"))))) + (error + "socket-connect: bad arg ~s" + args))))) (internet-address->socket-address host port))) ((= protocol-family protocol-family/unix) (unix-address->socket-address (car args))) (else - (error "socket-connect: unsupported protocol-family"))))) + (error "socket-connect: unsupported protocol-family ~s" + protocol-family))))) (connect-socket sock addr) sock)) @@ -56,14 +59,16 @@ (service-info:port (service-info arg "tcp"))) (else - (error "socket-connect: bad arg"))))) + (error "socket-connect: bad arg ~s" + arg))))) (internet-address->socket-address internet-address/any arg))) ((= protocol-family protocol-family/unix) (unix-address->socket-address arg)) (else - (error "bind-listen-accept-loop: unsupported protocol-family"))))) + (error "bind-listen-accept-loop: unsupported protocol-family ~s" + protocol-family))))) (set-socket-option sock level/socket socket/reuse-address #t) (bind-socket sock addr) (listen-socket sock 5) @@ -95,9 +100,11 @@ ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (define (internet-address->socket-address address32 port16) (cond ((not (<= 0 address32 #xffffffff)) - (error "internet-address->socket-address: address out of range")) + (error "internet-address->socket-address: address out of range ~s" + address32)) ((not (<= 0 port16 #xffff)) - (error "internet-address->socket-address: port out of range")) + (error "internet-address->socket-address: port out of range ~s" + port16)) (else (make-socket-address address-family/internet (string-append (integer->string address32) @@ -107,7 +114,8 @@ (if (or (not (socket-address? sockaddr)) (not (= (socket-address:family sockaddr) address-family/internet))) - (error "socket-address->internet-address: internet socket expected") + (error "socket-address->internet-address: internet socket expected ~s" + sockaddr) (values (string->integer (substring (socket-address:address sockaddr) 0 4)) (string->integer (substring (socket-address:address sockaddr) @@ -115,20 +123,21 @@ (define (unix-address->socket-address path) (if (> (string-length path) 108) - (error "unix-address->socket-address: path too long") + (error "unix-address->socket-address: path too long ~s" path) (make-socket-address address-family/unix path))) (define (socket-address->unix-address sockaddr) (if (or (not (socket-address? sockaddr)) (not (= (socket-address:family sockaddr) address-family/unix))) - (error "socket-address->unix-address expects an unix socket") + (error "socket-address->unix-address expects an unix socket ~s" sockaddr) socket-address:address)) (define (make-addr af) (make-string (cond ((= af address-family/unix) 108) ((= af address-family/internet) 8) - (else (error "make-addr: unknown address-family"))))) + (else + (error "make-addr: unknown address-family ~s" af))))) ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;; socket syscall @@ -139,7 +148,8 @@ (if (not (and (integer? pf) (integer? type) (integer? protocol))) - (error "create-socket: integer arguments expected") + (error "create-socket: integer arguments expected ~s ~s ~s" + pf type protocol) (let* ((fd (%socket pf type protocol)) (in (make-input-fdport fd)) (out (dup->outport in))) @@ -168,14 +178,15 @@ ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (define (bind-socket sock name) (cond ((not (socket? sock)) - (error "bind-socket: socket expected")) + (error "bind-socket: socket expected ~s" sock)) ((not (socket-address? name)) - (error "bind-socket: socket-address expected")) + (error "bind-socket: socket-address expected ~s" name)) (else (let ((family (socket:family sock))) (if (not (= family (socket-address:family name))) (error - "bind-socket: trying to bind incompatible address to socket") + "bind-socket: trying to bind incompatible address to socket ~s" + name) (%bind (socket->fdes sock) family (socket-address:address name))))))) @@ -193,14 +204,15 @@ ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (define (connect-socket sock name) (cond ((not (socket? sock)) - (error "connect-socket: socket expected")) + (error "connect-socket: socket expected ~s" sock)) ((not (socket-address? name)) - (error "connect-socket: socket-address expected")) + (error "connect-socket: socket-address expected ~s" name)) (else (let ((family (socket:family sock))) (cond ((not (= family (socket-address:family name))) (error - "connect: trying to connect socket to incompatible address")) + "connect: trying to connect socket to incompatible address ~s" + name)) (else (%connect (socket->fdes sock) (socket:family sock) @@ -219,9 +231,9 @@ ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (define (listen-socket sock backlog) (cond ((not (socket? sock)) - (error "listen-socket: socket expected")) + (error "listen-socket: socket expected ~s" sock)) ((not (integer? backlog)) - (error "listen-socket: integer expected")) + (error "listen-socket: integer expected ~s" backlog)) (else (%listen (socket->fdes sock) backlog)))) @@ -237,7 +249,7 @@ ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (define (accept-connection sock) (if (not (socket? sock)) - (error "accept-connection: socket expected") + (error "accept-connection: socket expected ~s" sock) (let* ((family (socket:family sock)) (name (make-addr family)) (fd (%accept (socket->fdes sock) family name)) @@ -263,7 +275,7 @@ (define (socket-remote-address sock) (if (or (not (socket? sock)) (not (= (socket:family sock) address-family/internet))) - (error "socket-remote-address: internet socket expected") + (error "socket-remote-address: internet socket expected ~s" sock) (let* ((family (socket:family sock)) (name (make-addr family))) (%peer-name (socket->fdes sock) @@ -285,7 +297,7 @@ (define (socket-local-address sock) (if (or (not (socket? sock)) (not (= (socket:family sock) address-family/internet))) - (error "socket-local-address: internet socket expected") + (error "socket-local-address: internet socket expected ~s" sock) (let* ((family (socket:family sock)) (name (make-addr family))) (%socket-name (socket->fdes sock) @@ -307,9 +319,9 @@ ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (define (shutdown-socket sock how) (cond ((not (socket? sock)) - (error "shutdown-socket: socket expected")) + (error "shutdown-socket: socket expected ~s" sock)) ((not (integer? how)) - (error "shutdown-socket: integer expected")) + (error "shutdown-socket: integer expected ~s" how)) (else (%shutdown (socket->fdes sock) how)))) @@ -326,7 +338,7 @@ ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (define (create-socket-pair type) (if (not (integer? type)) - (error "create-socket-pair: integer argument expected") + (error "create-socket-pair: integer argument expected ~s" type) (receive (s1 s2) (%socket-pair type) (let* ((in1 (make-input-fdport s1)) @@ -357,10 +369,10 @@ (receive (flags) (parse-optionals maybe-flags 0) (cond ((not (socket? socket)) - (error "receive-message: socket expected")) + (error "receive-message: socket expected ~s" socket)) ((or (not (integer? flags)) (not (integer? len))) - (error "receive-message: integer expected")) + (error "receive-message: integer expected ~s ~s" flags len)) (else (let ((s (make-string len))) (receive (nread from) @@ -373,15 +385,16 @@ (define (receive-message! socket s . maybe-args) (if (not (string? s)) - (error "receive-message!: string expected") + (error "receive-message!: string expected ~s" s) (receive (start end flags) (parse-optionals maybe-args 0 (string-length s) 0) (cond ((not (socket? socket)) - (error "receive-message!: socket expected")) + (error "receive-message!: socket expected ~s" socket)) ((not (or (integer? flags) (integer? start) (integer? end))) - (error "receive-message!: integer expected")) + (error "receive-message!: integer expected ~s ~s ~s" + flags start end)) (else (generic-receive-message! (socket->fdes socket) flags s start end @@ -414,10 +427,10 @@ (receive (flags) (parse-optionals maybe-flags 0) (cond ((not (socket? socket)) - (error "receive-message/partial: socket expected")) + (error "receive-message/partial: socket expected ~s" socket)) ((or (not (integer? flags)) (not (integer? len))) - (error "receive-message/partial: integer expected")) + (error "receive-message/partial: integer expected ~s ~s" flags len)) (else (let ((s (make-string len))) (receive (nread addr) @@ -430,13 +443,15 @@ (define (receive-message!/partial socket s . maybe-args) (if (not (string? s)) - (error "receive-message!/partial: string expected") + (error "receive-message!/partial: string expected ~s" s) (receive (start end flags) (parse-optionals maybe-args 0 (string-length s) 0) (cond ((not (socket? socket)) - (error "receive-message!/partial: socket expected")) + (error "receive-message!/partial: socket expected ~s" + socket)) ((not (integer? flags)) - (error "receive-message!/partial: integer expected")) + (error "receive-message!/partial: integer expected ~s" + flags)) (else (generic-receive-message!/partial (socket->fdes socket) flags @@ -483,11 +498,11 @@ (parse-optionals maybe-args 0 (string-length s) 0 #f) (cond ((not (socket? socket)) - (error "send-message: socket expected")) + (error "send-message: socket expected ~s" socket)) ((not (integer? flags)) - (error "send-message: integer expected")) + (error "send-message: integer expected ~s" flags)) ((not (string? s)) - (error "send-message: string expected")) + (error "send-message: string expected ~s" s)) (else (generic-send-message (socket->fdes socket) flags s start end @@ -517,11 +532,11 @@ (parse-optionals maybe-args 0 (string-length s) 0 #f) (cond ((not (socket? socket)) - (error "send-message/partial: socket expected")) + (error "send-message/partial: socket expected ~s" socket)) ((not (integer? flags)) - (error "send-message/partial: integer expected")) + (error "send-message/partial: integer expected ~s" flags)) ((not (string? s)) - (error "send-message/partial: string expected")) + (error "send-message/partial: string expected ~s" s)) (else (generic-send-message/partial (socket->fdes socket) flags s start end @@ -564,29 +579,33 @@ (define (socket-option sock level option) (cond ((not (socket? sock)) - (error "socket-option: socket expected")) + (error "socket-option: socket expected ~s" sock)) ((or (not (integer? level))(not (integer? option))) - (error "socket-option: integer expected")) + (error "socket-option: integer expected ~s ~s" level option)) ((boolean-option? option) (let ((result (%getsockopt (socket->fdes sock) level option))) - (cond ((= result -1) (error "socket-option")) + (cond ((= result -1) + (error "socket-option ~s ~s ~s" sock level option)) (else (not (= result 0)))))) ((value-option? option) (let ((result (%getsockopt (socket->fdes sock) level option))) - (cond ((= result -1) (error "socket-option")) + (cond ((= result -1) + (error "socket-option ~s ~s ~s" sock level option)) (else result)))) ((linger-option? option) (receive (result/on-off time) (%getsockopt-linger (socket->fdes sock) level option) - (cond ((= result/on-off -1) (error "socket-option")) + (cond ((= result/on-off -1) + (error "socket-option ~s ~s ~s" sock level option)) (else (if (= result/on-off 0) #f time))))) ((timeout-option? option) (receive (result/secs usecs) (%getsockopt-linger (socket->fdes sock) level option) - (cond ((= result/secs -1) (error "socket-option")) - (else (+ result/secs (/ usecs 1000)))))) + (cond ((= result/secs -1) + (error "socket-option ~s ~s ~s" sock level option)) + (else (+ result/secs (/ usecs 1000)))))) (else - "socket-option: unknown option type"))) + "socket-option: unknown option type ~s" option))) (define-foreign %getsockopt/errno (scheme_getsockopt (integer sockfd) @@ -630,9 +649,9 @@ (define (set-socket-option sock level option value) (cond ((not (socket? sock)) - (error "set-socket-option: socket expected")) + (error "set-socket-option: socket expected ~s" sock)) ((or (not (integer? level)) (not (integer? option))) - (error "set-socket-option: integer expected")) + (error "set-socket-option: integer expected ~s ~s" level option)) ((boolean-option? option) (%setsockopt (socket->fdes sock) level option (if value 1 0))) ((value-option? option) @@ -713,17 +732,17 @@ (define (host-info arg) (cond ((string? arg) (name->host-info arg)) ((socket-address? arg) (address->host-info arg)) - (else (error "host-info: string or socket-address expected")))) + (else (error "host-info: string or socket-address expected ~s" arg)))) (define (address->host-info name) (if (or (not (socket-address? name)) (not (= (socket-address:family name) address-family/internet))) - (error "address->host-info: internet address expected") + (error "address->host-info: internet address expected ~s" name) (receive (herrno name aliases addresses) (%host-address->host-info/h-errno (socket-address:address name)) (if herrno - (error "address->host-info: non-zero herrno" herrno) + (error "address->host-info: non-zero herrno ~s ~s" name herrno) (make-host-info name (vector->list (C-string-vec->Scheme aliases #f)) @@ -739,11 +758,11 @@ (define (name->host-info name) (if (not (string? name)) - (error "name->host-info: string expected") + (error "name->host-info: string expected ~s" name) (receive (herrno name aliases addresses) (%host-name->host-info/h-errno name) (if herrno - (error "name->host-info: non-zero herrno" herrno) + (error "name->host-info: non-zero herrno ~s ~s" herrno name) (make-host-info name (vector->list (C-string-vec->Scheme aliases #f)) @@ -769,11 +788,12 @@ (define (network-info arg) (cond ((string? arg) (name->network-info arg)) ((socket-address? arg) (address->network-info arg)) - (else (error "network-info: string or socket-address expected")))) + (else + (error "network-info: string or socket-address expected ~s" arg)))) (define (address->network-info name) (if (not (integer? name)) - (error "address->network-info: integer expected") + (error "address->network-info: integer expected ~s" name) (let ((name (integer->string name)) (net (make-string 4))) (receive (result name aliases) @@ -792,7 +812,7 @@ (define (name->network-info name) (if (not (string? name)) - (error "name->network-info: string expected") + (error "name->network-info: string expected ~s" name) (let ((net (make-string 4))) (receive (result name aliases) (%net-name->network-info name net) @@ -819,15 +839,15 @@ (define (service-info . args) (cond ((string? (car args)) (apply name->service-info args)) ((integer? (car args)) (apply port->service-info args)) - (else (error "service-info: string or integer expected")))) + (else (error "service-info: string or integer expected ~s" args)))) (define (port->service-info name . maybe-proto) (receive (proto) (parse-optionals maybe-proto "") (cond ((not (integer? name)) - (error "port->service-info: integer expected")) + (error "port->service-info: integer expected ~s" name)) ((not (string? proto)) - (error "port->service-info: string expected")) + (error "port->service-info: string expected ~s" proto)) (else (receive (result name aliases port protocol) (%service-port->service-info name proto) @@ -851,7 +871,7 @@ (parse-optionals maybe-proto "") (if (or (not (string? name)) (not (string? name))) - (error "name->service-info: string expected") + (error "name->service-info: string expected ~s" name) (receive (result name aliases port protocol) (%service-name->service-info name proto) (make-service-info name @@ -879,11 +899,11 @@ (define (protocol-info arg) (cond ((string? arg) (name->protocol-info arg)) ((integer? arg) (number->protocol-info arg)) - (else (error "protocol-info: string or integer expected")))) + (else (error "protocol-info: string or integer expected ~s" arg)))) (define (number->protocol-info name) (if (not (integer? name)) - (error "number->protocol-info: integer expected") + (error "number->protocol-info: integer expected ~s" name) (receive (result name aliases protocol) (%protocol-port->protocol-info name) (make-protocol-info name @@ -900,7 +920,7 @@ (define (name->protocol-info name) (if (not (string? name)) - (error "name->protocol-info: string expected") + (error "name->protocol-info: string expected ~s" name) (receive (result name aliases protocol) (%protocol-name->protocol-info name) (make-protocol-info name