From 1bf7db77ab983804af5f26e4043816c8a238d738 Mon Sep 17 00:00:00 2001
From: erana <jceuppen@vub.ac.be>
Date: Tue, 17 Jan 2012 19:02:57 +0900
Subject: [PATCH] tmail refactor - 2

---
 scsh/tmail/tforks.scm  | 97 ++++++++++++++++++++----------------------
 scsh/tmail/tserver.scm |  4 +-
 2 files changed, 48 insertions(+), 53 deletions(-)

diff --git a/scsh/tmail/tforks.scm b/scsh/tmail/tforks.scm
index 9abf796..a77949c 100644
--- a/scsh/tmail/tforks.scm
+++ b/scsh/tmail/tforks.scm
@@ -55,53 +55,50 @@
              (socket-accept *socket))
          (lambda (in out)
            (write *motd out)
-           (do ((i 0 (+ i 1))) ;; iterate
-               ((> i 9)(display *bye)(newline))
-             (call-with-values
-                 (lambda ()
-                   '((read in)(read in)(read in)))
-               (lambda (answer)
-                 (let ((answer2 (car answer))
-                       (answer3 (if (not (null? (cdr answer)))
-                                    (cadr answer)
-                                    'foo)))
-                   (for-each display '((servermsg) (symbol->string answer2) " "  answer3 (eoln)))
-                   (if (symbol? answer2)
-                       (cond ((eq? 'APOP answer2)
-                              (write mailbox-contents out)
-                              )
-                             ((eq? 'STAT answer2)
-                              #t)
-                             ((eq? 'LIST answer2)
-                              #t)
-                             ((eq? 'RETR answer2)
-                              (let ((idx (string->number (symbol->string answer3))))
-                                (if idx
-                                    (write (tmail-get-mail-with-index (getenv "USER") idx) out))))
-                             ((eq? 'USER answer2)
-                              (let ((username (if (number? answer3)
-                                                  (number->string answer3)
-                                                  (symbol->string answer3))))
-                                (setenv "USER" username)
-                                (write "+OK user accepted - not implemented" out)))
-                             ((eq? 'PASS answer2)
-                              (let ((pass (if (number? answer3)
-                                              (number->string answer3)
-                                              (symbol->string answer3))))
-                                (write "+OK password accepted - not implemented" out)))
-                             ((eq? 'QUIT answer2)
-                              (write *bye out)
-                              (close-input-port in)
-                              (close-socket *socket)
-                              (close-output-port out)
-                              (exit))
-                             (else
-                              (write (errormsg) out))
-                             ))
-                   ))))
-           (write *bye out)
-           (close-input-port in)
-           (close-socket *socket)
-           (close-output-port out)
-           (exit)
-           ))))))
\ No newline at end of file
+           (let ((answer (read (make-string-input-port in))))
+             (for-each display '((servermsg) (symbol->string answer)))
+             (if (symbol? answer)
+                 (cond ((eq? 'APOP answer)
+                        (write mailbox-contents out)
+                        )
+                       ((eq? 'STAT answer)
+                        #t)
+                       ((eq? 'LIST answer)
+                        #t)
+                       ((eq? 'RETR answer)
+                        (let ((answer2 (read (make-string-input-port in))))
+                          (let ((idx (string->number (symbol->string answer3))))
+                            (if idx
+                                (write (tmail-get-mail-with-index (getenv "USER") idx) out)))))
+                       ((eq? 'USER answer)
+                        (let* ((answer2 (read (make-string-input-port in)))
+                               ((username (if (number? answer2)
+                                              (number->string answer2)
+                                              (symbol->string answer2)))))
+                          (setenv "USER" username)
+                          (write "+OK user accepted - not implemented" out)))
+                       ((eq? 'PASS answer)
+                        (let* ((answer2 (read (make-string-input-port in)))
+                               (pass (if (number? answer2)
+                                         (number->string answer2)
+                                         (symbol->string answer2))))
+                          (write "+OK password accepted - not implemented" out)))
+                       ((eq? 'QUIT answer)
+                        (write *bye out)
+                        (close-input-port in)
+                        (close-socket *socket)
+                        (close-output-port out)
+                        (exit))
+                       (else
+                        (write (errormsg) out))
+                       ))
+             )))))
+
+
+    (let ((answer2 (read (make-string-input-port in))))
+      (for-each display '((servermsg) (symbol->string answer2)))
+      (write *bye out)
+      (close-input-port in)
+      (close-socket *socket)
+      (close-output-port out)
+      (exit))))
\ No newline at end of file
diff --git a/scsh/tmail/tserver.scm b/scsh/tmail/tserver.scm
index 0924255..0693a28 100644
--- a/scsh/tmail/tserver.scm
+++ b/scsh/tmail/tserver.scm
@@ -38,6 +38,4 @@
        ;;(let ((answer (make-string-input-port in))) ; returns any server response into some string
       ;;FIXME(close-input-port in)
       ;;answer)
-       )))
-
-
+       )))
\ No newline at end of file