1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: sockets.lisp
6 ;;;; Purpose: Socket functions
7 ;;;; Programmer: Kevin M. Rosenberg with excerpts from portableaserve
8 ;;;; Date Started: Jun 2003
10 ;;;; $Id: sockets.lisp,v 1.3 2003/07/10 18:52:10 kevin Exp $
11 ;;;; *************************************************************************
15 (eval-when (:compile-toplevel :load-toplevel :execute)
16 #+sbcl (require :sb-bsd-sockets)
17 #+lispworks (require "comm")
18 #+allegro (require :socket))
22 (defun listen-to-inet-port (&key (port 0) (kind :stream) (reuse nil))
23 "Create, bind and listen to an inet socket on *:PORT.
24 setsockopt SO_REUSEADDR if :reuse is not nil"
25 (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
29 (setf (sb-bsd-sockets:sockopt-reuse-address socket) t))
30 (sb-bsd-sockets:socket-bind
31 socket (sb-bsd-sockets:make-inet-address "0.0.0.0") port)
32 (sb-bsd-sockets:socket-listen socket 15)
35 (defun create-inet-listener (port &key (format :text) (reuse-address t))
36 #+cmu (ext:create-inet-listener port)
38 (socket:make-socket :connect :passive :local-port port :format :binary
42 (if (or (null port) (integerp port))
44 (error "illegal value for port: ~s" port)))
45 :reuse-address reuse-address)
47 (listen-to-inet-port :port port :reuse reuse-address)
48 #+clisp (ext:socket-server port)
49 #-(or allegro clisp cmu sbcl)
50 (warn "create-inet-listener not supported on this implementation")
53 (defun make-fd-stream (socket &key input output element-type)
55 (sys:make-fd-stream socket :input input :output output
56 :element-type element-type)
58 (sb-bsd-sockets:socket-make-stream socket :input input :output output
59 :element-type element-type)
60 #-(or cmu sbcl) (declare (ignore input output element-type))
61 #-(or cmu sbcl) socket
65 (defun accept-tcp-connection (listener)
67 (socket:accept-connection listener)
69 (ext:socket-accept listener)
72 (mp:process-wait-until-fd-usable listener :input)
74 (nth-value 0 (ext:accept-tcp-connection listener))
77 (when (sb-sys:wait-until-fd-usable
78 (sb-bsd-sockets:socket-file-descriptor listener) :input)
79 (sb-bsd-sockets:socket-make-stream
80 (sb-bsd-sockets:socket-accept listener)
81 :element-type 'base-char
83 #-(or allegro clisp cmu sbcl)
84 (warn "accept-tcp-connection not supported on this implementation")
88 (defmacro errorset (form display)
92 (declare (ignorable e))
94 (format t "~&Error: ~A~%" e)))))
96 (defun close-passive-socket (socket)
97 #+allegro (close socket)
98 #+clisp (close socket)
99 #+cmu (unix:unix-close socket)
100 #+sbcl (sb-unix:unix-close
101 (sb-bsd-sockets:socket-file-descriptor socket))
102 #-(or allegro clisp cmu sbcl)
103 (warn "close-passive-socket not supported on this implementation")
107 (defun close-active-socket (socket)
111 (defun ipaddr-to-dotted (ipaddr &key values)
112 "Convert from 32-bit integer to dotted string."
113 (declare (type (unsigned-byte 32) ipaddr))
114 (let ((a (logand #xff (ash ipaddr -24)))
115 (b (logand #xff (ash ipaddr -16)))
116 (c (logand #xff (ash ipaddr -8)))
117 (d (logand #xff ipaddr)))
120 (format nil "~d.~d.~d.~d" a b c d))))
123 (defun dotted-to-ipaddr (dotted &key (errorp t))
124 "Convert from dotted string to 32-bit integer."
125 (declare (string dotted))
127 (let ((ll (string-tokens (substitute #\Space #\. dotted))))
128 (+ (ash (first ll) 24) (ash (second ll) 16)
129 (ash (third ll) 8) (fourth ll)))
131 (let ((ll (string-tokens (substitute #\Space #\. dotted))))
132 (+ (ash (first ll) 24) (ash (second ll) 16)
133 (ash (third ll) 8) (fourth ll))))))
136 (defun ipaddr-to-hostname (ipaddr &key ignore-cache)
138 (warn ":IGNORE-CACHE keyword in IPADDR-TO-HOSTNAME not supported."))
139 (sb-bsd-sockets:host-ent-name
140 (sb-bsd-sockets:get-host-by-address
141 (sb-bsd-sockets:make-inet-address ipaddr))))
144 (defun lookup-hostname (host &key ignore-cache)
146 (warn ":IGNORE-CACHE keyword in LOOKUP-HOSTNAME not supported."))
148 (sb-bsd-sockets:host-ent-address
149 (sb-bsd-sockets:get-host-by-name host))
150 (dotted-to-ipaddr (ipaddr-to-dotted host))))
153 (defun make-active-socket (server port)
154 #+allegro (socket:make-socket :remote-host server
156 #+lispworks (comm:open-tcp-stream server port)
157 #+sbcl (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
160 (sb-bsd-sockets:socket-connect
161 socket (lookup-hostname server) port)
162 (sb-bsd-sockets:socket-make-stream socket
165 :element-type 'base-char))
167 (sys:make-fd-stream (ext:connect-to-inet-socket host port)
168 :input t :output t :element-type 'base-char)