scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

tmail refactor - 2

This commit is contained in:
erana 2012-01-17 19:02:57 +09:00
parent 3af7ef7c6d
commit 1bf7db77ab
2 changed files with 48 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
scsh/tmail/tforks.scm
View File

@ -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)
))))))
(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))))

4
scsh/tmail/tserver.scm
View File

@ -38,6 +38,4 @@
;;(let ((answer (make-string-input-port in))) ; returns any server response into some string
;;FIXME(close-input-port in)
;;answer)
)))
)))