[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Gcl-devel] opening a socket to a web server
From: |
Camm Maguire |
Subject: |
Re: [Gcl-devel] opening a socket to a web server |
Date: |
25 Feb 2004 10:01:36 -0500 |
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2 |
Greetings! Another good example of what you're looking for can be
found in the tkconnect source from the tk package:
(defun tkconnect (&key host can-rsh gcltksrv (display (si::getenv "DISPLAY"))
(args "")
&aux hostid (loopback "127.0.0.1"))
(if *tk-connection* (tkdisconnect))
(or display (error "DISPLAY not set"))
(or *tk-library* (setq *tk-library* (si::getenv "TK_LIBRARY")))
(or gcltksrv
(setq gcltksrv
(cond (host "gcltksrv")
((si::getenv "GCL_TK_SERVER"))
((probe-file (tk-conc si::*lib-directory* "/gcl-tk/gcltksrv")))
((probe-file (tk-conc si::*lib-directory* "gcl-tk/gcltksrv")))
(t (error "Must setenv GCL_TK_SERVER ")))))
(let ((pid (if host -1 (si::getpid)))
(tk-socket (si::open-named-socket 0))
)
(cond ((not host) (setq hostid loopback))
(host (setq hostid (si::hostname-to-hostid (si::gethostname)))))
(or hostid (error "Can't find my address"))
(setq tk-socket (si::open-named-socket 0))
(if (pathnamep gcltksrv) (setq gcltksrv (namestring gcltksrv)))
(let ((command
(tk-conc gcltksrv " " hostid " "
(cdr tk-socket) " "
pid " " display " "
args
)))
(print command)
(cond ((not host) (system command))
(can-rsh
(system (tk-conc "rsh " host " " command
" < /dev/null &")))
(t (format t "Waiting for you to invoke GCL_TK_SERVER,
on ~a as in: ~s~%" host command )))
(let ((ar *text-variable-locations*))
(declare (type (array (t)) ar))
(sloop for i below (length ar) by 2
do (remprop (aref ar i) 'linked-variable-type)))
(setf (fill-pointer *text-variable-locations*) 0)
(setf (fill-pointer *call-backs*) 0)
(setq *tk-connection* (si::accept-socket-connection tk-socket ))
(if (eql pid -1)
(si::SET-SIGIO-FOR-FD (car (car *tk-connection*))))
(setf *sigusr1* nil)
(tk-do (tk-conc "source " si::*lib-directory* "gcl-tk/gcl.tcl"))
)))
"Mike Thomas" <address@hidden> writes:
> Hi Michael.
>
> Others may have something more specific to say as I'm not well versed on GCL
> sockets (or sockets in general) but here is the documentation from the C
> source.
>
> DEFUN_NEW("OPEN-NAMED-SOCKET",object,fSopen_named_socket,SI,1,1,NONE,OI,OO,O
> O,OO,(fixnum port),
> "Open a socket on PORT and return (cons fd portname) where file \
> descriptor is a small fixnum which is the write file descriptor for \
> the socket. If PORT is zero do automatic allocation of port")
>
>
> DEFUN_NEW("ACCEPT-SOCKET-CONNECTION",object,fSaccept_socket_connection,
> SI,1,1,NONE,OO,OO,OO,OO,(object named_socket),
> "Given a NAMED_SOCKET it waits for a connection on this \
> and returns (list* named_socket fd name1) when one is established")
>
> I have no idea how well these functions work on Windows but my suspicion is
> not very well if at all. SI::SOCKET works to the extent that Maxima uses it
> (see the example code below).
This is good to hear. I thought we had some socket corruption on
Windows. Does this mean that tk now works?
>
> Camm - notice that the doc strings of these DEFUN_NEW functions are not
> ending up in a place accessible to the CL "describe" function - a bug which
> I think we should try and fix to avoid wastage of useful information.
>
Right, we certainly need to address this in 2.7.x. For some reason
I've heard people disparage doc-strings, so I think we need some
thought/consensus on what is the right, clean thing to re
documentation.
Take care,
> Cheers
>
> Mike Thomas.
>
> >From the Maxima source code here is an example of how to use SI::SOCKET:
>
> ;; very simple server started on port
>
> (and (find-package "MAXIMA") (push :maxima *features*))
>
> #+maxima
> (in-package "MAXIMA")
>
>
>
> (defun user::setup ( port &optional (host "localhost"))
> (let* ((sock (open-socket host port)))
> (setq me sock)
> #+gcl (setq si::*sigpipe-action* 'si::bye)
> (setq *socket-connection* sock)
> (setq *standard-input* sock)
> (setq *standard-output* sock)
> (setq *error-output* sock)
> (setq *terminal-io* sock)
> (format t "pid=~a~%" (getpid))
> (force-output sock)
> (setq *debug-io* sock)
> (values)
> ))
>
> ;;; from CLOCC: <http://clocc.sourceforge.net>
> (defun open-socket (host port &optional bin)
> "Open a socket connection to HOST at PORT."
> (declare (type (or integer string) host) (fixnum port) (type boolean bin))
> (let ((host (etypecase host
> (string host)
> (integer (hostent-name (resolve-host-ipaddr host))))))
> #+allegro (socket:make-socket :remote-host host :remote-port port
> :format (if bin :binary :text))
> #+clisp (socket-connect port host :element-type
> (if bin '(unsigned-byte 8) 'character))
>
> #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket host port)
> :input t :output t :element-type
> (if bin '(unsigned-byte 8) 'character))
> #+gcl (si::socket port :host host)
> #+lispworks (comm:open-tcp-stream host port :direction :io :element-type
> (if bin 'unsigned-byte 'base-char))
> #-(or allegro clisp cmu gcl lispworks)
> (error 'not-implemented :proc (list 'open-socket host port bin))))
>
>
>
> #+maxima
> (progn
> (setq $in_netmath t)
> (setq $show_openplot nil))
>
> #+clisp
> (defun getpid ( &aux tem)
>
> (cond ((fboundp 'sys::program-id)
> (sys::program-id))
> ; ;under windows above does not work.
> ((consp (setq tem (errset (system::getenv "PID"))))
> (read-from-string (car tem)))
> (t (format t "using fake value for pid") -1))
> )
> #+cmu
> (defun getpid () (unix:unix-getpid))
>
> #+(or gcl clisp cmu)
> (defun xchdir (w)
> #+clisp (cd w)
> #+gcl (si::chdir w)
> #+cmu (unix::unix-chdir w)
> )
>
>
>
>
>
> | -----Original Message-----
> | From: address@hidden
> | [mailto:address@hidden
> | Behalf Of michael philetus weller
> | Sent: Wednesday, 25 February 2004 1:08 PM
> | To: address@hidden
> | Subject: [Gcl-devel] opening a socket to a web server
> |
> |
> | hi,
> |
> | I am running gcl 2.5.0 in gnu emacs on windows xp and am trying to build a
> | web crawler for a class assignment at the university of washington. I
> | downloaded this windows binary from
> |
> | http://www.cs.utexas.edu/users/novak/gclwin.html
> |
> | When I type
> |
> | (apropos 'socket)
> |
> | I get
> |
> | SYSTEM:ACCEPT-SOCKET-CONNECTION Function
> | SYSTEM:SOCKET Function
> | SYSTEM:OPEN-NAMED-SOCKET Function
> | SOCKET
> |
> | but I can't find any documentation on any of these functions in the
> | documentation folder.
> |
> | I noticed in the news item on the 2.5.1 release that sockets are listed
> | under the features.
> |
> | could you point me towards some documentation or code samples that could
> | help?
> |
> | thanks,
> |
> | mike weller
> | address@hidden
> |
> |
> | _______________________________________________
> | Gcl-devel mailing list
> | address@hidden
> | http://mail.gnu.org/mailman/listinfo/gcl-devel
> |
> |
>
>
>
>
> _______________________________________________
> Gcl-devel mailing list
> address@hidden
> http://mail.gnu.org/mailman/listinfo/gcl-devel
>
>
>
--
Camm Maguire address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah