Re: Scheme book recommendations

[Mikael Djurfeldt <mdj at mdj dot nada dot kth dot se>]

hjstein@bfr.co.il (Harvey J. Stein) writes:

> Mikael Djurfeldt <mdj@mdj.nada.kth.se> writes:
> 
>  > cwitty@newtonlabs.com (Carl R. Witty) writes:
>  > 
>  > > Before you put this in any guile documentation, please add warnings
>  > > that say that if you run this on a machine connected to the Internet,
>  > > anybody in the world can do anything they want to your files...
>  > 
>  > Yes, actually, it might not be such a good idea to publish such code
>  > at all.  We should probably add code to at least verify that the host
>  > is "safe":
> 
> So you're only allowing everyone on the machine into your account
> instead of everyone on the internet?  Still not so cool.
> 
> One of the points of guile as opposed to other languages is the safety
> of programming with it.  We shouldn't give examples that are
> fundamentally unsafe.
> 
> A server example should be cognizant of the dangers of writing a
> server.  If we had a safe-top-repl, we could use that.

We have now... (Guile-1.4.1)  :)

----------------------------------------------------------------------
#!/usr/local/bin/guile -s
!#
;;;; 	Copyright (C) 1997, 2000 Free Software Foundation, Inc.
;;;; 
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;; 
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;; 


;;; Author: Mikael Djurfeldt, based upon code by Gary Houston
;;; Version: 1.3
;;; Works with Guile snapshots beginning with 000622

;;; This file implements a simple Guile server.
;;;
;;; It enables a Guile interpreter to work as a server, supplying
;;; multiple repl sessions, each running in its own thread.
;;;
;;; Load this file into a Guile running on machine x.y.z.w and type
;;;
;;;   (server)
;;;
;;; Then type
;;;
;;;   telnet x.y.z.w 2345
;;;
;;; at the shell prompt.  ("x.y.z.w" can be replaced by "localhost" if
;;; telnet is running on the same machine as the interpreter.)
;;;
;;; Use `(quit)' at the telnet (Guile) prompt to close down a
;;; connection.
;;;
;;; BUGS: Currently, signals (like interrupt) don't work.
;;;

(use-modules (ice-9 threads) (ice-9 safe))

(define server-port 2345)

(define (server-report action address p)
  (display (strftime "%y%m%d %H:%M:%S: " (localtime (current-time))) p)
  (display action p)
  (display " connection from " p)
  (display (inet-ntoa (sockaddr:addr address)) p)
  (display " at port " p)
  (display (sockaddr:port address) p)
  (newline p))

(define (server)
  (let ((o (current-output-port))
	(port (socket AF_INET SOCK_STREAM 0)))
    (bind port AF_INET INADDR_ANY server-port)
    (listen port 10)			; Queue up to 10 requests.
    (let loop ()
      (select (list port) () ())
      (let ((p (accept port)))
	(begin-thread
	 (server-report "Opening" (cdr p) o)
	 (server-repl (car p))
	 (server-report "Closing" (cdr p) o)
	 (close-port (car p))))
      (loop))))

(define (server-repl p)
  (set-current-input-port p)
  (set-current-output-port p)
  (set-current-error-port p)
  (set-current-module (make-safe-module)) ; New module with safe subset of R5RS
  (eval `(define quit ,quit))		  ; Define their quit to be our quit
  (scm-style-repl))

(server)