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

[Mike Thomas]

Thank you too Michael.

I hadn't woken up to the fact that you could both read and write to that
socket using normal lisp functions.

Does this mean that we could use system:socket to drive our Tcl server with
repeated commands and presumably subsequent feedback from the driver and
that an eof would be received only when the Tcl server exited or
deliberately sent one?

Cheers

Mike Thomas.


| -----Original Message-----
| From: address@hidden
| [mailto:address@hidden
| Behalf Of michael philetus weller
| Sent: Thursday, 26 February 2004 7:29 AM
| To: Camm Maguire
| Cc: Mike Thomas; address@hidden
| Subject: Re: [Gcl-devel] opening a socket to a web server
|
|
| hi,
|
| thanks for your help. the 'system:socket' function seems to work great on
| windows now that I see how to call it. here is the code I wrote to fetch a
| web page as a string that seems to be working ok:
|
| ******************************************************************
| *********
|
| ;;; gcl fetch-web-page
| ;;; fetch a web page as a string in gcl
|
| (defun fetch-web-page (address-x path-x)
|   """requests the web page at path-x from the server at address-x and
|      returns it as a string"""
|   ; get socket to webserver at address-x
|   (let ((socket-x (system:socket 80 :host address-x)))
|     ; request page from server
|     (write-line (concatenate 'string "GET " path-x) socket-x)
|     ; read page from socket as string
|     (read-socket-to-string socket-x)))
| ;(print (fetch-web-page "www.washington.edu" "/index.html"))
|
| (defun read-socket-to-string (socket-x)
|   """recurse and read lines from a socket to a string until eof is true"""
|   ; set line-x to a string containing the next line and eof-x to t or nil
|   (multiple-value-bind (line-x eof-x) (read-line socket-x)
|     (cond
|       ; if eof-x is true then the end of the file has been reached so
|       ; close the socket and return an empty string
|       (eof-x (close socket-x) "")
|       ; concatenate this line with the next one and return it
|       (t (concatenate 'string line-x (read-socket-to-string socket-x))))))
|
| ******************************************************************
| ***********
|
| thanks,
|
| mike weller
| address@hidden
|
| On Wed, 25 Feb 2004, Camm Maguire wrote:
|
| > 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,NO
NE,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
| >
|
|
| _______________________________________________
| Gcl-devel mailing list
| address@hidden
| http://mail.gnu.org/mailman/listinfo/gcl-devel
|
|