Starting to insert syslog-calls in ftpd.

ftpd.scm

@@ -69,12 +69,57 @@
 (define set-session-data-socket (make-fluid-setter set-session:data-socket)) 
 (define set-session-passive-socket (make-fluid-setter set-session:passive-socket))
 
+(define log
+  (lambda (level format-message . args)
+    (syslog level 
+	    (apply format #f format-message args)
+	    (format "ftpd[~D]" (thread-uid (current-thread)))
+	    #f 
+	    (syslog-facility daemon))))
+
+(define (protocol-family->string protocol-family)
+  (cond ((= protocol-family protocol-family/unspecified)
+	 "unspecified")
+	((= protocol-family protocol-family/internet)
+	 "internet")
+	((= protocol-family protocol-family/unix)
+	 "unix")
+	(else "unknown")))
+
+(define (socket->string socket)
+  (format #f "family: ~A, local address: ~A, remote address: ~A, input-port ~A, output-port ~A"
+	  (protocol-family->string (socket:family socket))
+	  (socket-address->string (socket-local-address socket))
+	  (socket-address->string (socket-remote-address socket))
+	  (socket:inport socket)
+	  (socket:outport socket)))
+
+(define (socket-address->string socket-address)
+  (call-with-values
+   (lambda () (socket-address->internet-address socket-address))
+   (lambda (host-address service-port)
+     (format #f "~A:~A"
+	     (format-internet-host-address host-address)
+	     (format-port service-port)))))
+
 (define (ftpd anonymous-home . maybe-port)
   (let ((port (optional maybe-port 21)))
+    (log (syslog-level notice) 
+	 "starting on port ~D with ~S as anonymous home"
+	 port (expand-file-name anonymous-home (cwd)))
     (bind-listen-accept-loop
      protocol-family/internet
      (lambda (socket address)
        
+       (log (syslog-level info)
+	    "new connection with ~S"
+	    (socket-address->string address)
+
+       (log (syslog-level debug)
+	    "got connection with socket ~S and address ~S"
+	    (socket->string socket) 
+	    (socket-address->string address))
+
        (set-ftp-socket-options! socket)
        
        (spawn
@@ -90,14 +135,34 @@
 		 ;; I dunno why SHUTDOWN-SOCKET can die this way, but it
 		 ;; can and does
 		 ((= errno errno/notconn)
+		  (log (syslog-level warning) 
+		       "socket not connected any more - exiting thread")
+		  (log (syslog-level debug) "socket ~S not connected any more"
+		       (socket->string socket))
 		  (exit 'fick-dich-ins-knie))))
 	      (lambda ()
+		(log (syslog-level debug)
+		     "shutting down socket ~S"
+		     (socket->string socket))
 		(shutdown-socket socket shutdown/sends+receives)))))
-	  (close-socket socket))))
+	  (log (syslog-level info)
+	       "closing socket")
+	  (close-socket socket))
+	(socket-address->string address))))    ; use remote address as thread-name
      
      port)))
 
 (define (ftpd-inetd anonymous-home)
+  (log (syslog-level info)
+       "new connection on current input- and output-port with ~S as anonymous home"
+       (expand-file-name anonymous-home (cwd)))
+
+  (log (syslog-level debug)
+       "new connection on current input-port ~A and current output-port ~A with ~S as anonymous home"
+       (current-input-port)
+       (current-output-port)
+       (expand-file-name anonymous-home (cwd)))
+  
   (handle-connection (current-input-port)
 		     (current-output-port)
 		     (file-name-as-directory anonymous-home)))
@@ -811,7 +876,7 @@
 
 ; Version
 
-(define *ftpd-version* "$Revision: 1.16 $")
+(define *ftpd-version* "$Revision: 1.17 $")
 
 (define (copy-port->port-binary input-port output-port)
   (let ((buffer (make-string *window-size*)))