Re: [Gcl-devel] opening a socket to a web server

[Camm Maguire]

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