- (line (string-downcase (read-line in-port))))
- (cond
- ((string-prefix? "helo" line)
- (message-helo-set! msg (string-drop line (string-length "helo")))
- (smtp-ok out-port)
- (loop msg (string-downcase (read-line in-port))))
- ((string-prefix? "mail from:" line)
- (message-from-set! msg (string-drop line (string-length "mail from:")))
- (smtp-ok out-port)
- (loop msg (string-downcase (read-line in-port))))
- ((string-prefix? "rcpt to:" line)
- (message-to-set! msg (string-drop line (string-length "rcpt to:")))
- (smtp-ok out-port)
- (loop msg (string-downcase (read-line in-port))))
- ((string-prefix? "data" line)
- (let text-loop ((text-line (read-line in-port))
- (text ""))
- (print "Received '" text-line "'")
- (if (string=? "." text-line)
- (message-text-set! msg text)
- (text-loop (read-line in-port)
- (conc text text-line))))
- (deliver-message msg)
- (smtp-ok out-port)
- (loop (make-empty-message)
- (string-downcase (read-line in-port))))
- ((string-prefix? "quit" line)
- (smtp-close out-port)
- 'done)
- (else
- (smtp-no out-port)))))
+ (line-orig (read-line in-port)))
+ (if (string? line-orig)
+ (let ((line (string-downcase line-orig)))
+ (cond
+ ((string-prefix? "helo" line)
+ (message-helo-set! msg (string-drop line (string-length "helo")))
+ (print "got " line)
+ (smtp-ok out-port)
+ (loop msg (read-line in-port)))
+ ((string-prefix? "mail from:" line)
+ (print "got " line)
+ (message-from-set! msg (string-drop line (string-length "mail from:")))
+ (smtp-ok out-port)
+ (loop msg (read-line in-port)))
+ ((string-prefix? "rcpt to:" line)
+ (print "got " line)
+ (message-to-set! msg (string-drop line (string-length "rcpt to:")))
+ (smtp-ok out-port)
+ (loop msg (read-line in-port)))
+ ((string-prefix? "data" line)
+ (print "got " line)
+ (smtp-intermediate out-port)
+ (let text-loop ((text-line (read-line in-port))
+ (text ""))
+ (print "Received '" text-line "'")
+ (if (string=? "." text-line)
+ (message-text-set! msg text)
+ (text-loop (read-line in-port)
+ (conc text text-line))))
+ (deliver-message msg)
+ (smtp-ok out-port)
+ (loop (make-empty-message)
+ (read-line in-port)))
+ ((string-prefix? "quit" line)
+ (smtp-close out-port)
+ 'done)
+ ((string=? "" line)
+ (loop msg (read-line in-port)))
+ (else
+ (smtp-no out-port)
+ (print "got " line)
+ (loop msg (read-line in-port)))))
+ 'done)))