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

55
scsh/tmail/tforks.scm
View File

@ -55,41 +55,35 @@
(socket-accept *socket)) (socket-accept *socket))
(lambda (in out) (lambda (in out)
(write *motd out) (write *motd out)
(do ((i 0 (+ i 1))) ;; iterate (let ((answer (read (make-string-input-port in))))
((> i 9)(display *bye)(newline)) (for-each display '((servermsg) (symbol->string answer)))
(call-with-values (if (symbol? answer)
(lambda () (cond ((eq? 'APOP answer)
'((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) (write mailbox-contents out)
) )
((eq? 'STAT answer2) ((eq? 'STAT answer)
#t) #t)
((eq? 'LIST answer2) ((eq? 'LIST answer)
#t) #t)
((eq? 'RETR answer2) ((eq? 'RETR answer)
(let ((answer2 (read (make-string-input-port in))))
(let ((idx (string->number (symbol->string answer3)))) (let ((idx (string->number (symbol->string answer3))))
(if idx (if idx
(write (tmail-get-mail-with-index (getenv "USER") idx) out)))) (write (tmail-get-mail-with-index (getenv "USER") idx) out)))))
((eq? 'USER answer2) ((eq? 'USER answer)
(let ((username (if (number? answer3) (let* ((answer2 (read (make-string-input-port in)))
(number->string answer3) ((username (if (number? answer2)
(symbol->string answer3)))) (number->string answer2)
(symbol->string answer2)))))
(setenv "USER" username) (setenv "USER" username)
(write "+OK user accepted - not implemented" out))) (write "+OK user accepted - not implemented" out)))
((eq? 'PASS answer2) ((eq? 'PASS answer)
(let ((pass (if (number? answer3) (let* ((answer2 (read (make-string-input-port in)))
(number->string answer3) (pass (if (number? answer2)
(symbol->string answer3)))) (number->string answer2)
(symbol->string answer2))))
(write "+OK password accepted - not implemented" out))) (write "+OK password accepted - not implemented" out)))
((eq? 'QUIT answer2) ((eq? 'QUIT answer)
(write *bye out) (write *bye out)
(close-input-port in) (close-input-port in)
(close-socket *socket) (close-socket *socket)
@ -98,10 +92,13 @@
(else (else
(write (errormsg) out)) (write (errormsg) out))
)) ))
)))) )))))
(let ((answer2 (read (make-string-input-port in))))
(for-each display '((servermsg) (symbol->string answer2)))
(write *bye out) (write *bye out)
(close-input-port in) (close-input-port in)
(close-socket *socket) (close-socket *socket)
(close-output-port out) (close-output-port out)
(exit) (exit))))
))))))

2
scsh/tmail/tserver.scm
View File

@ -39,5 +39,3 @@
;;FIXME(close-input-port in) ;;FIXME(close-input-port in)
;;answer) ;;answer)
))) )))