renamend pop3-procedures (':' --> '-')

updated docu and exports accordingly
added new pop3-obsolete structure, mapping old names to new ones
This commit is contained in:
interp 2002-05-12 05:53:44 +00:00
parent 7792db48f4
commit 906ef5571c
3 changed files with 84 additions and 67 deletions

View File

@ -31,7 +31,7 @@ messages.
\subsection{Entry points} \subsection{Entry points}
\begin{defundesc}{pop3:connect}{\ovar{host \ovar{logfile}}}{connection} \begin{defundesc}{pop3-connect}{\ovar{host \ovar{logfile}}}{connection}
Connect to the maildrop server named \semvar{host}. Optionally log Connect to the maildrop server named \semvar{host}. Optionally log
the conversation with the server to \semvar{logfile}, which will be the conversation with the server to \semvar{logfile}, which will be
appended to if it exists, and created otherwise. The environment appended to if it exists, and created otherwise. The environment
@ -40,16 +40,16 @@ messages.
\end{defundesc} \end{defundesc}
In the further descriptions of the procedures, \semvar{connection} In the further descriptions of the procedures, \semvar{connection}
always refers to the result of \ex{pop3:\ob{}connect}. always refers to the result of \ex{pop3-\ob{}connect}.
\begin{defundesc}{pop3:login} {connection \ovar{login \ovar{password}}}{status} \begin{defundesc}{pop3-login} {connection \ovar{login \ovar{password}}}{status}
Log in to the mailhost. If a \semvar{login} and \semvar{password} Log in to the mailhost. If a \semvar{login} and \semvar{password}
are not provided, they are first searched for in the user's ~/.netrc are not provided, they are first searched for in the user's ~/.netrc
file. USER/PASS authentication will be tried first, and if file. USER/PASS authentication will be tried first, and if
this fails, APOP authentication (secure) will be tried. this fails, APOP authentication (secure) will be tried.
\end{defundesc} \end{defundesc}
\begin{defundesc}{pop3:login/APOP} {connection login password}{status} \begin{defundesc}{pop3-login/APOP} {connection login password}{status}
Log in to the mailhost using APOP authentication\footnote{The encryption Log in to the mailhost using APOP authentication\footnote{The encryption
(MD5) is currently done by an extern program that your system must (MD5) is currently done by an extern program that your system must
provide. The expected name of the program is \ex{md5sum}. If your system provide. The expected name of the program is \ex{md5sum}. If your system
@ -57,39 +57,39 @@ always refers to the result of \ex{pop3:\ob{}connect}.
program's name in \ex{md5-digest}.}. program's name in \ex{md5-digest}.}.
\end{defundesc} \end{defundesc}
\begin{defundesc}{pop3:stat}{connection}{number bytes} \begin{defundesc}{pop3-stat}{connection}{number bytes}
Return the number of messages and the number of bytes waiting in the Return the number of messages and the number of bytes waiting in the
maildrop. maildrop.
\end{defundesc} \end{defundesc}
\begin{defundesc}{pop3:get}{connection msgid}{status} \begin{defundesc}{pop3-get}{connection msgid}{status}
Download message number \semvar{msgid} from the mailhost. Download message number \semvar{msgid} from the mailhost.
\semvar{msgid} must be positive and less than the number of messages \semvar{msgid} must be positive and less than the number of messages
returned by the \ex{pop3:\ob{}stat} call. The message contents are sent to returned by the \ex{pop3-\ob{}stat} call. The message contents are sent to
\ex{(cur\ob{}rent-\ob{}out\ob{}put-\ob{}port)}. \ex{(cur\ob{}rent-\ob{}out\ob{}put-\ob{}port)}.
\end{defundesc} \end{defundesc}
\begin{defundesc}{pop3:headers}{connection msgid}{status} \begin{defundesc}{pop3-headers}{connection msgid}{status}
Download the headers of message number \semvar{msgid}. The data is sent to Download the headers of message number \semvar{msgid}. The data is sent to
\ex{(cur\ob{}rent-\ob{}out\ob{}put-\ob{}port)}. \ex{(cur\ob{}rent-\ob{}out\ob{}put-\ob{}port)}.
\end{defundesc} \end{defundesc}
\begin{defundesc}{pop3:last}{connection}{msgid} \begin{defundesc}{pop3-last}{connection}{msgid}
Return the highest accessed message-id number for the current Return the highest accessed message-id number for the current
session. This isn't in the RFC, but seems to be supported by several session. This isn't in the RFC, but seems to be supported by several
servers. servers.
\end{defundesc} \end{defundesc}
\begin{defundesc}{pop3:delete}{connection msgid}{status} \begin{defundesc}{pop3-delete}{connection msgid}{status}
Mark message number \semvar{msgid} for deletion. The message will Mark message number \semvar{msgid} for deletion. The message will
not be deleted until the client logs out. not be deleted until the client logs out.
\end{defundesc} \end{defundesc}
\begin{defundesc}{pop3:reset}{connection}{status} \begin{defundesc}{pop3-reset}{connection}{status}
Any messages which have been marked for deletion are unmarked. Any messages which have been marked for deletion are unmarked.
\end{defundesc} \end{defundesc}
\begin{defundesc}{pop3:quit}{connection}{status} \begin{defundesc}{pop3-quit}{connection}{status}
Close the connection with the mailhost. Close the connection with the mailhost.
\end{defundesc} \end{defundesc}

View File

@ -664,6 +664,17 @@
;; pop3.scm is a module for accessing email on a maildrop server, ;; pop3.scm is a module for accessing email on a maildrop server,
;; using the POP3 protocol. ;; using the POP3 protocol.
(define-interface pop3-interface (define-interface pop3-interface
(export pop3-connect
pop3-login
pop3-stat
pop3-get
pop3-headers
pop3-last
pop3-delete
pop3-reset
pop3-quit))
(define-interface pop3-obsolete-interface
(export pop3:connect (export pop3:connect
pop3:login pop3:login
pop3:stat pop3:stat
@ -686,6 +697,12 @@
scheme) scheme)
(files pop3)) (files pop3))
(define-structure pop3-obsolete pop3-obsolete-interface
(open scsh
scheme
pop3)
(files pop3-obsolete))
;; nettime.scm is a module for requesting the time on remote machines, ;; nettime.scm is a module for requesting the time on remote machines,
;; using the time or the daytime protocol ;; using the time or the daytime protocol

110
pop3.scm
View File

@ -1,6 +1,6 @@
;;; POP3.scm --- implement the POP3 maildrop protocol in the Scheme Shell ;;; POP3.scm --- implement the POP3 maildrop protocol in the Scheme Shell
;; ;;
;; $Id: pop3.scm,v 1.4 2002/03/29 17:47:24 interp Exp $ ;; $Id: pop3.scm,v 1.5 2002/05/12 05:53:44 interp Exp $
;; ;;
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr> ;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
@ -31,48 +31,48 @@
;;; Entry points ======================================================= ;;; Entry points =======================================================
;; ;;
;; (pop3:connect [host logfile]) -> connection ;; (pop3-connect [host logfile]) -> connection
;; Connect to the maildrop server named HOST. Optionally log the ;; Connect to the maildrop server named HOST. Optionally log the
;; conversation with the server to LOGFILE, which will be appended ;; conversation with the server to LOGFILE, which will be appended
;; to if it exists, and created otherwise. The environment variable ;; to if it exists, and created otherwise. The environment variable
;; MAILHOST, if set, will override the value of HOST. ;; MAILHOST, if set, will override the value of HOST.
;; ;;
;; (pop3:login connection [login password]) -> status ;; (pop3-login connection [login password]) -> status
;; Log in to the mailhost. If a login and password are not ;; Log in to the mailhost. If a login and password are not
;; provided, they are first searched for in the user's ~/.netrc ;; provided, they are first searched for in the user's ~/.netrc
;; file. USER/PASS authentication will be tried first, and if this ;; file. USER/PASS authentication will be tried first, and if this
;; fails, APOP authentication will be tried. ;; fails, APOP authentication will be tried.
;; ;;
;; (pop3:login/APOP connection login password) -> status ;; (pop3-login/APOP connection login password) -> status
;; Log in to the mailhost using APOP authentication. ;; Log in to the mailhost using APOP authentication.
;; ;;
;; (pop3:stat connection) -> integer x integer ;; (pop3-stat connection) -> integer x integer
;; Return the number of messages and the number of bytes waiting in ;; Return the number of messages and the number of bytes waiting in
;; the maildrop. ;; the maildrop.
;; ;;
;; (pop3:get connection msgid) -> status ;; (pop3-get connection msgid) -> status
;; Download message number MSGID from the mailhost. MSGID must be ;; Download message number MSGID from the mailhost. MSGID must be
;; positive and less than the number of messages returned by the ;; positive and less than the number of messages returned by the
;; pop3:stat call. The message contents are sent to ;; pop3-stat call. The message contents are sent to
;; (current-output-port). ;; (current-output-port).
;; ;;
;; (pop3:headers connection msgid) -> status ;; (pop3-headers connection msgid) -> status
;; Download the headers of message number MSGID. The data is sent ;; Download the headers of message number MSGID. The data is sent
;; to (current-output-port). ;; to (current-output-port).
;; ;;
;; (pop3:last connection) -> integer ;; (pop3-last connection) -> integer
;; Return the highest accessed message-id number for the current ;; Return the highest accessed message-id number for the current
;; session. This isn't in the RFC, but seems to be supported by ;; session. This isn't in the RFC, but seems to be supported by
;; several servers. ;; several servers.
;; ;;
;; (pop3:delete connection msgid) -> status ;; (pop3-delete connection msgid) -> status
;; Mark message number MSGID for deletion. The message will not be ;; Mark message number MSGID for deletion. The message will not be
;; deleted until the client logs out. ;; deleted until the client logs out.
;; ;;
;; (pop3:reset connection) -> status ;; (pop3-reset connection) -> status
;; Any messages which have been marked for deletion are unmarked. ;; Any messages which have been marked for deletion are unmarked.
;; ;;
;; (pop3:quit connection) -> status ;; (pop3-quit connection) -> status
;; Close the connection with the mailhost. ;; Close the connection with the mailhost.
@ -126,7 +126,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;: [host x logfile] -> connection ;;: [host x logfile] -> connection
(define (pop3:connect . args) (define (pop3-connect . args)
(let* ((host (or (getenv "MAILHOST") (let* ((host (or (getenv "MAILHOST")
(safe-first args))) (safe-first args)))
(logfile (safe-second args)) (logfile (safe-second args))
@ -146,14 +146,14 @@
(connection (make-pop3-connection hostname (connection (make-pop3-connection hostname
sock sock
LOG "" "" #f #f))) LOG "" "" #f #f)))
(pop3:log connection (pop3-log connection
(format #f "~%-- ~a: opened POP3 connection to ~a" (format #f "~%-- ~a: opened POP3 connection to ~a"
;; (date->string (date)) ;; (date->string (date))
"Dummy date" ; (format-time-zone) is broken in v0.5.1 "Dummy date" ; (format-time-zone) is broken in v0.5.1
hostname)) hostname))
;; read the challenge the server sends in its welcome banner ;; read the challenge the server sends in its welcome banner
(let* ((banner (pop3:read-response connection)) (let* ((banner (pop3-read-response connection))
(match (regexp-search (rx (posix-string "\\+OK .* (<[^>]+>)")) banner)) (match (regexp-search (rx (posix-string "\\+OK .* (<[^>]+>)")) banner))
(challenge (and match (match:substring match 1)))) (challenge (and match (match:substring match 1))))
(set-pop3-connection:challenge connection challenge)) (set-pop3-connection:challenge connection challenge))
@ -164,23 +164,23 @@
;; first try standard USER/PASS authentication, and switch to APOP ;; first try standard USER/PASS authentication, and switch to APOP
;; authentication if the server prefers. ;; authentication if the server prefers.
;;: [string x string] -> status ;;: [string x string] -> status
(define (pop3:login connection . args) (define (pop3-login connection . args)
(let* ((netrc (and (< (length args) 2) (netrc:parse))) (let* ((netrc (and (< (length args) 2) (netrc:parse)))
(login (or (safe-first args) (login (or (safe-first args)
(netrc:lookup-login netrc (pop3-connection:host-name connection) #f) (netrc:lookup-login netrc (pop3-connection:host-name connection) #f)
(call-error "must provide a login" pop3:login args))) (call-error "must provide a login" pop3-login args)))
(password (or (safe-second args) (password (or (safe-second args)
(netrc:lookup-password netrc (pop3-connection:host-name connection) #f) (netrc:lookup-password netrc (pop3-connection:host-name connection) #f)
(call-error "must provide a password" pop3:login args)))) (call-error "must provide a password" pop3-login args))))
(with-handler (with-handler
(lambda (result punt) (lambda (result punt)
(if (-ERR? result) (if (-ERR? result)
(if (pop3-connection:challenge connection) (if (pop3-connection:challenge connection)
(pop3:login/APOP connection login password) (pop3-login/APOP connection login password)
(error "login failed")))) (error "login failed"))))
(lambda () (lambda ()
(pop3:send-command connection (format #f "USER ~a" login)) (pop3-send-command connection (format #f "USER ~a" login))
(pop3:send-command connection (format #f "PASS ~a" password)) (pop3-send-command connection (format #f "PASS ~a" password))
(set-pop3-connection:login connection login) (set-pop3-connection:login connection login)
(set-pop3-connection:password connection password) (set-pop3-connection:password connection password)
(set-pop3-connection:state connection 'connected))))) (set-pop3-connection:state connection 'connected)))))
@ -209,11 +209,11 @@
;; c4c9334bac560ecc979e58001b3e22fb ;; c4c9334bac560ecc979e58001b3e22fb
;; ;;
;;: connection x string x string -> status ;;: connection x string x string -> status
(define (pop3:login/APOP connection login password) (define (pop3-login/APOP connection login password)
(let* ((key (string-append (pop3-connection:challenge connection) (let* ((key (string-append (pop3-connection:challenge connection)
password)) password))
(digest (md5-digest key)) (digest (md5-digest key))
(status (pop3:send-command connection (status (pop3-send-command connection
(format #f "APOP ~a ~a" login digest)))) (format #f "APOP ~a ~a" login digest))))
(set-pop3-connection:login connection login) (set-pop3-connection:login connection login)
(set-pop3-connection:password connection password) (set-pop3-connection:password connection password)
@ -223,55 +223,55 @@
;; return number of messages and number of bytes waiting at the maildrop ;; return number of messages and number of bytes waiting at the maildrop
;;: connection -> integer x integer ;;: connection -> integer x integer
(define (pop3:stat connection) (define (pop3-stat connection)
(pop3:check-transaction-state connection 'pop3:stat) (pop3-check-transaction-state connection 'pop3-stat)
(let* ((response (pop3:send-command connection "STAT")) (let* ((response (pop3-send-command connection "STAT"))
(match (regexp-search (rx (posix-string "([0-9]+) ([0-9]+)")) response))) (match (regexp-search (rx (posix-string "([0-9]+) ([0-9]+)")) response)))
(values (string->number (match:substring match 1)) (values (string->number (match:substring match 1))
(string->number (match:substring match 2))))) (string->number (match:substring match 2)))))
;; dump the message number MSGID to (current-output-port) ;; dump the message number MSGID to (current-output-port)
;;: connection x integer -> status ;;: connection x integer -> status
(define (pop3:get connection msgid) (define (pop3-get connection msgid)
(pop3:check-transaction-state connection 'pop3:get) (pop3-check-transaction-state connection 'pop3-get)
(let ((status (pop3:send-command connection (format #f "RETR ~a" msgid)))) (let ((status (pop3-send-command connection (format #f "RETR ~a" msgid))))
(pop3:dump (socket:inport (pop3-connection:command-socket connection))) (pop3-dump (socket:inport (pop3-connection:command-socket connection)))
status)) status))
;;: connection x integer -> status ;;: connection x integer -> status
(define (pop3:headers connection msgid) (define (pop3-headers connection msgid)
(pop3:check-transaction-state connection 'pop3:headers) (pop3-check-transaction-state connection 'pop3-headers)
(let ((status (pop3:send-command connection (format #f "TOP ~a 0" msgid)))) (let ((status (pop3-send-command connection (format #f "TOP ~a 0" msgid))))
(pop3:dump (socket:inport (pop3-connection:command-socket connection))) (pop3-dump (socket:inport (pop3-connection:command-socket connection)))
status)) status))
;; Return highest accessed message-id number for the session. This ;; Return highest accessed message-id number for the session. This
;; ain't in the RFC, but seems to be supported by several servers. ;; ain't in the RFC, but seems to be supported by several servers.
;;: connection -> integer ;;: connection -> integer
(define (pop3:last connection) (define (pop3-last connection)
(pop3:check-transaction-state connection 'pop3:last) (pop3-check-transaction-state connection 'pop3-last)
(let ((response (pop3:send-command connection "LAST"))) (let ((response (pop3-send-command connection "LAST")))
(string->number (car ((infix-splitter) response))))) (string->number (car ((infix-splitter) response)))))
;; mark the message number MSGID for deletion. Note that the messages ;; mark the message number MSGID for deletion. Note that the messages
;; are not truly deleted until the QUIT command is sent, and messages ;; are not truly deleted until the QUIT command is sent, and messages
;; can be undeleted using the RSET command. ;; can be undeleted using the RSET command.
;;: connection x integer -> status ;;: connection x integer -> status
(define (pop3:delete connection msgid) (define (pop3-delete connection msgid)
(pop3:check-transaction-state connection 'pop3:delete) (pop3-check-transaction-state connection 'pop3-delete)
(pop3:send-command connection (format #f "DELE ~a" msgid))) (pop3-send-command connection (format #f "DELE ~a" msgid)))
;; any messages which have been marked for deletion are unmarked ;; any messages which have been marked for deletion are unmarked
;;: connection -> status ;;: connection -> status
(define (pop3:reset connection) (define (pop3-reset connection)
(pop3:check-transaction-state connection 'pop3:reset) (pop3-check-transaction-state connection 'pop3-reset)
(pop3:send-command connection "RSET")) (pop3-send-command connection "RSET"))
;;: connection -> status ;;: connection -> status
(define (pop3:quit connection) (define (pop3-quit connection)
(pop3:check-transaction-state connection 'pop3:quit) (pop3-check-transaction-state connection 'pop3-quit)
(let ((status (pop3:send-command connection "QUIT"))) (let ((status (pop3-send-command connection "QUIT")))
(close-socket (pop3-connection:command-socket connection)) (close-socket (pop3-connection:command-socket connection))
status)) status))
@ -293,19 +293,19 @@
(define -ERR? (condition-predicate '-ERR)) (define -ERR? (condition-predicate '-ERR))
(define (pop3:check-transaction-state connection caller) (define (pop3-check-transaction-state connection caller)
(if (not (eq? (pop3-connection:state connection) 'connected)) (if (not (eq? (pop3-connection:state connection) 'connected))
(call-error "not in transaction state" caller))) (call-error "not in transaction state" caller)))
(define (pop3:read-response connection) (define (pop3-read-response connection)
(let* ((sock (pop3-connection:command-socket connection)) (let* ((sock (pop3-connection:command-socket connection))
(IN (socket:inport sock)) (IN (socket:inport sock))
(line (read-line IN))) (line (read-line IN)))
(pop3:log connection (format #f "-> ~a" line)) (pop3-log connection (format #f "-> ~a" line))
line)) line))
;; this could perhaps be improved ;; this could perhaps be improved
(define (pop3:handle-response response command) (define (pop3-handle-response response command)
(let ((match (regexp-search (rx (posix-string "^\\+OK(.*)")) response))) (let ((match (regexp-search (rx (posix-string "^\\+OK(.*)")) response)))
(if match (if match
(match:substring match 1) (match:substring match 1)
@ -315,20 +315,20 @@
(signal '-ERR response command)))))) (signal '-ERR response command))))))
(define (pop3:log connection line) (define (pop3-log connection line)
(let ((LOG (pop3-connection:logfd connection))) (let ((LOG (pop3-connection:logfd connection)))
(and LOG (and LOG
(write-string line LOG) (write-string line LOG)
(write-string "\n" LOG) (write-string "\n" LOG)
(force-output LOG)))) (force-output LOG))))
(define (pop3:send-command connection command) (define (pop3-send-command connection command)
(let* ((sock (pop3-connection:command-socket connection)) (let* ((sock (pop3-connection:command-socket connection))
(OUT (socket:outport sock))) (OUT (socket:outport sock)))
(write-string command OUT) (write-string command OUT)
(write-crlf OUT) (write-crlf OUT)
(pop3:log connection (format #f "<- ~a" command)) (pop3-log connection (format #f "<- ~a" command))
(pop3:handle-response (pop3:read-response connection) command))) (pop3-handle-response (pop3-read-response connection) command)))
;; who will write this in Scheme? ;; who will write this in Scheme?
@ -337,7 +337,7 @@
; the name of the program differs among the distributions ; the name of the program differs among the distributions
; e.g. in FreeBSD it is called md5 ; e.g. in FreeBSD it is called md5
(define (pop3:dump fd) (define (pop3-dump fd)
(let loop ((line (read-line fd))) (let loop ((line (read-line fd)))
(cond ((and (not (eof-object? line)) (cond ((and (not (eof-object? line))
(not (equal? line ".\r"))) (not (equal? line ".\r")))