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)) (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))) (write mailbox-contents out)
(lambda (answer) )
(let ((answer2 (car answer)) ((eq? 'STAT answer)
(answer3 (if (not (null? (cdr answer))) #t)
(cadr answer) ((eq? 'LIST answer)
'foo))) #t)
(for-each display '((servermsg) (symbol->string answer2) " " answer3 (eoln))) ((eq? 'RETR answer)
(if (symbol? answer2) (let ((answer2 (read (make-string-input-port in))))
(cond ((eq? 'APOP answer2) (let ((idx (string->number (symbol->string answer3))))
(write mailbox-contents out) (if idx
) (write (tmail-get-mail-with-index (getenv "USER") idx) out)))))
((eq? 'STAT answer2) ((eq? 'USER answer)
#t) (let* ((answer2 (read (make-string-input-port in)))
((eq? 'LIST answer2) ((username (if (number? answer2)
#t) (number->string answer2)
((eq? 'RETR answer2) (symbol->string answer2)))))
(let ((idx (string->number (symbol->string answer3)))) (setenv "USER" username)
(if idx (write "+OK user accepted - not implemented" out)))
(write (tmail-get-mail-with-index (getenv "USER") idx) out)))) ((eq? 'PASS answer)
((eq? 'USER answer2) (let* ((answer2 (read (make-string-input-port in)))
(let ((username (if (number? answer3) (pass (if (number? answer2)
(number->string answer3) (number->string answer2)
(symbol->string answer3)))) (symbol->string answer2))))
(setenv "USER" username) (write "+OK password accepted - not implemented" out)))
(write "+OK user accepted - not implemented" out))) ((eq? 'QUIT answer)
((eq? 'PASS answer2) (write *bye out)
(let ((pass (if (number? answer3) (close-input-port in)
(number->string answer3) (close-socket *socket)
(symbol->string answer3)))) (close-output-port out)
(write "+OK password accepted - not implemented" out))) (exit))
((eq? 'QUIT answer2) (else
(write *bye out) (write (errormsg) out))
(close-input-port in) ))
(close-socket *socket) )))))
(close-output-port out)
(exit))
(else (let ((answer2 (read (make-string-input-port in))))
(write (errormsg) out)) (for-each display '((servermsg) (symbol->string answer2)))
)) (write *bye out)
)))) (close-input-port in)
(write *bye out) (close-socket *socket)
(close-input-port in) (close-output-port out)
(close-socket *socket) (exit))))
(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 ;;(let ((answer (make-string-input-port in))) ; returns any server response into some string
;;FIXME(close-input-port in) ;;FIXME(close-input-port in)
;;answer) ;;answer)
))) )))