#!/usr/local/bin/guile \
--debug -e main -s
!#
;;; schmolester --- A simple peer-to-peer file-sharing program

;;      Copyright (C) 2004 Michael L. Gran
;;
;; 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
;;
;; This code incorporates (slurp) and (slurp-file!) from
;; http://lists.gnu.org/archive/html/guile-sources/2003-09/msg00009.html
;; (slurp) is  
;;      Copyright (C) 2002,2003 Free Software Foundation, Inc.
;; and is also released under the GPL.  

;;; Author: Michael L. Gran <spikegran@earthlink.net>
;;  incorporating (slurp) from Thien-Thi Nguyen 
;;  based on MoleSter v0.0.2 by Matthew Skala
;;  http://ansuz.sooke.bc.ca/software/molester/

;;; Commentary:

;; Usage: schmolester password my-ip peer-ip commands
;;
;; Quoting from "MoleSter" v0.0.2 documentation by Matthew Skala
;; <<<To set up a schmolester peer:
;; schmolester password 192.168.1.1:2222 10.2.2.2:3333

;; replace password with the password for your network, 192.168.1.1:2222 with
;; the local address and port to run on, 10.2.2.2:3333 with the remote
;; address and port of another MoleSter peer; if the other peer doesn't
;; exist, your peer will still go up, but you'll have to wait for others to
;; connect to you.

;; If there is no other peer to connect to, use your local address twice.

;; The port-number protection has been removed, so be cautious!  Nobody can
;; make your peer connect out to random addresses without knowing your
;; password, but even so, I don't really recommend running this on the
;; public Internet.

;; Addresses must be specified as dotted quad decimal, as shown above.

;; You can add commands to get files or advertise your presence by adding
;; additional command line arguments of the form <cmdchar><arg>/

;; Example, to connect to a network and request a file from peers:
;; schmolester password 192.168.1.1:2222 10.2.2.2:3333 \
;;    gkernel-sources.tar.bz2/

;; Note that you probably should not really use this to distribute the kernel
;; sources, unless you have a LOT of memory and bandwidth to spare.

;; Note that no incoming files are processed until all outgoing requests
;; have been processed.  I'm trying to figure out a way to change that
;; without using a lot of bytes - maybe for version 0.0.3.  The practical
;; result is that stacking up more than two or three requests on a command
;; line may not work very well, and you may have to manually experiment with
;; recursion and so on.  But what the heck, it's more reliable than
;; Freenet and more scaleable than TinyP2P.

;; command reference:

;; i/  advertises your presence to the peer, which is a nice thing to do if
;; you plan to be up for a while

;; g<filename>/ requests a filename

;; h/ gets all your peers' peer lists and merges those into yours >>>
;; 

;; Note that you can turn off most of the screen output by setting
;; the variable +debug-port+ to a null port

(debug-enable 'backtrace)

(use-modules (ice-9 rw) (ice-9 regex))

;;; Global variables
(define *my-address* "")		; of the form "127.0.0.1:80"
(define *my-password* "")
(define *peers* '())

;; choose an output port for verbose information
(define +debug-port+ (current-output-port))
;;(define +debug-port+ (%make-void-port 'w'))

;;; Utility functions

;; Functions that convert strings of the form "100.100.100.100:8080"
;; into ip addresses and port numbers

;; extract "address" from "address:port"
(define (get-addr addr-and-port)
  (car (string-split addr-and-port #\:)))

;; extract port from "address:port"
(define (get-port addr-and-port)
  (string->number (cadr (string-split addr-and-port #\:))))

;; Read in an entire file from a port
(define (read-all port)
  (let loop ((block (make-string 32000)) (text ""))
    (let ((count (read-string!/partial block port)))
      (if count
	  (loop block (string-append text (substring block 0 count)))
	  text))))


;;; Peer-list functions

;; The peers are in an alist, but, the cdr of the alist isn't used
;; for anything.  
(define (add-peer! addr)
  (set! *peers*
       (assoc-set! *peers* addr #t)))

(define (remove-peer! addr)
  (set! *peers*
	(assoc-remove! *peers* addr)))

;; Put the cars of the alist into alist
(define (get-peer-list)
  (let loop ((p *peers*) (peer-list '()))
    (if (not (null? p))
	(loop (cdr p) (append peer-list (list (caar p))))
	peer-list)))

;;; File operations

;; From TTN: put some of a file into the buffer "buf"
(define (slurp-file! buf fname-or-port rd-offset len wr-offset)
  (let* ((p? (port? fname-or-port))
         (port (if p? fname-or-port (open-input-file fname-or-port)))
         (end (+ wr-offset len))
         (smore-please (lambda (start)
                         (read-string!/partial buf port start end))))
    (seek port rd-offset SEEK_SET)
    (let loop ((this-time (smore-please wr-offset))
               (so-far 0))
      (and (< (+ so-far this-time) len)
           (loop (smore-please (+ so-far wr-offset))
                 (+ so-far this-time))))
    (or p? (close-port port)))
  buf)

;; From TTN: pull all of a list of files into a string, or to stdout
;; depending on how it is called
(define (slurp stuff)
  (cond ((list? stuff)
         (let* ((tot 0)
                (fsw (map (lambda (filename)
                            (let ((size (stat:size (stat filename)))
                                  (wr-offset tot))
                              (set! tot (+ tot size))
                              ;; "fsw": short for filename/size/wr-offset
                              (list filename 0 size wr-offset)))
                          stuff))
                (buf (make-string tot))
                (go! (lambda (fsw)
                       (apply slurp-file! buf fsw))))
           (for-each go! fsw)
           buf))
        ((string? stuff)
         (let ((size (stat:size (stat stuff))))
           (slurp-file! (make-string size) stuff 0 size 0)))
        (else
         ;; there is never enough drug humor in the world
         (error "bad stuff (dude)!"))))


;;; slurp ends here

;; Save string "str" as filename "filename"
(define (write-string-to-file str filename)
  (let ((file-port (open-output-file filename)))
    (display str file-port)
    (close-output-port file-port)))

;; Load file "filename" and return a string
(define (read-file filename)
  (slurp filename))

;;; The Main p2p operations

;; Make a properly formatted message and send it to a peer
(define (op-send dest-addr source-addr filename data)
  (let ((X (socket PF_INET SOCK_STREAM 
		   (protoent:proto (getprotobyname "tcp"))))
	(host (gethost (get-addr dest-addr)))
	(port (get-port dest-addr)))
    
    (if (catch 'system-error
	       (lambda ()
		 (connect X 
			  (hostent:addrtype host) 
			  (car (hostent:addr-list host))
			  port)
		 #t)
	       (lambda args #f))

	(begin
	  (format +debug-port+ "connecting to ~A\n" dest-addr)
	  (format +debug-port+  
		  "sending: ~A ~A ~A/\n" *my-password* source-addr filename)
	  (display
	   (format #f "~A ~A ~A/" *my-password* source-addr filename)
	   X)
	  (display data X)
	  (if (< 0 (string-length data))
	      (format +debug-port+ "connection complete, ~A bytes sent\n\n"
		      (string-length data))
	      (format +debug-port+ "connection complete\n\n"))
	      
	  (close-port X))
	;; else
	(remove-peer! dest-addr))))


;; E: Expect an incoming file
(define (op-expect-file filename data)
  (format +debug-port+ "receiving file ~A \n" filename)
  (write-string-to-file data filename))

;; F: Forward this request to your peers
(define (op-forward filename data)
  (for-each  
   (lambda (peer) 
     (begin 
       (format +debug-port+ "forwarding command ~A ~S to ~A\n" filename data peer)
       (op-send peer *my-address* filename data)))
   (get-peer-list)))

;; G: Give me a file
(define (op-give-file their-addr filename)
  (format +debug-port+ "sending file ~A to ~A\n" filename their-addr)
  (op-send their-addr 
	   *my-address* 
	   (string-append "e" filename) 
	   (read-file filename)))

;; H: Help me find peers
(define (op-expand-peers-list their-addr)
  (for-each
   (lambda (peer)
     (begin
       (format +debug-port+ "adding peer ~A to ~A's peer list\n" peer their-addr)
       (op-send their-addr peer "i" "")))
   (get-peer-list)))

;; I: I am a peer
;; addr is the address of a new peer
(define (op-add-peer addr)
  (format +debug-port+ "adding new peer ~A\n" addr)
  (add-peer! addr)
  (format +debug-port+ "peer list is now ~S\n" (get-peer-list)))

;;; The Main Loop
(define (main args)
  (let* ((my-password (list-ref args 1))
	 (my-address (list-ref args 2))
	 (peer-address (list-ref args 3))
	 (commands (list-tail args 4))
	 (host (gethost (get-addr my-address)))
	 (port (get-port my-address))
	 (S #f))

    (set! *my-password* my-password)
    (set! *my-address* my-address)
    (add-peer! peer-address)

    ;; Open a listening socket
    (set! S (socket PF_INET SOCK_STREAM (protoent:proto 
					 (getprotobyname "tcp"))))
    (bind S (hostent:addrtype host) 
	  (car (hostent:addr-list host))
	  port)
    (listen S 5)

    ;; Execute the commands from the command line.  The commands from the
    ;; command line aren't executed here, they are executed by the peers
    (for-each (lambda (c) (op-forward c ""))
	      commands)

    ;; Execute commands from the port received from other peers
    (while #t
	   (let* ((client-connection (accept S))
		  (client-details (cdr client-connection))
		  (client (car client-connection))
		  (buf (read-all client))
		  (matches 
		   (regexp-exec 
		    (make-regexp 
		     "^([a-zA-Z0-9]*) ([0-9:.]*) ([e-i])([^/]*)(/)" ) 
		    buf)))
	     (format +debug-port+ "new request from ~A\n"
			    (inet-ntoa (sockaddr:addr client-details)))
	     (if matches
		 (let ((password (match:substring matches 1))
		       (address (match:substring matches 2))
		       (command (string->symbol (match:substring matches 3)))
		       (filename (match:substring matches 4))
		       (data (substring buf (match:end matches 5))))
		   ;;(pretty-print matches)
		   (if (string=? password *my-password*)
		       ;; Print a log-file type message
		       (begin
			 (format #t "~A: ~A ~A ~A~A/ ~A\n"
				 *my-address*
				 password
				 address
				 command
				 filename
				 (get-peer-list))
			 (case command
			   ('e (op-expect-file filename data))
			   ('f (op-forward filename data))
			   ('g (op-give-file address filename))
			   ('h (op-expand-peers-list address))
			   ('i (op-add-peer address)))))))
	     (close client)
	     (format +debug-port+ "request complete\n\n")))))