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

[michael philetus weller]

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,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
>