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

make pop3.scm compliant with scsh 0.6.1 and the netrc.scm

This commit is contained in:
interp 2002-03-29 16:31:20 +00:00
parent 206de66403
commit 57e2820f37
1 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
pop3.scm
View File

@ -1,6 +1,6 @@
;;; POP3.scm --- implement the POP3 maildrop protocol in the Scheme Shell
;;
;; $Id: pop3.scm,v 1.2 2001/11/15 11:12:24 mainzelm Exp $
;; $Id: pop3.scm,v 1.3 2002/03/29 16:31:20 interp Exp $
;;
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
@ -138,7 +138,7 @@
#o600)))
(hst-info (host-info host))
(hostname (host-info:name hst-info))
(srvc-info (service-info "pop-3" "tcp"))
(srvc-info (service-info "pop3" "tcp"))
(sock (socket-connect protocol-family/internet
socket-type/stream
hostname
@ -164,15 +164,14 @@
;; first try standard USER/PASS authentication, and switch to APOP
;; authentication if the server prefers.
;;: [string x string] -> status
;; what are netrc:login / netrc:password supposed to do?
;; there is no equivalent procedure in netrc.scm
(define (pop3:login connection . args)
(let ((login (or (safe-first args)
(netrc:login (pop3-connection:host-name connection))
(call-error "must provide a login" pop3:login args)))
(password (or (safe-second args)
(netrc:password (pop3-connection:host-name connection))
(call-error "must provide a password" pop3:login args))))
(let* ((netrc (and (< (length args) 2) (netrc:parse)))
(login (or (safe-first args)
(netrc:lookup-login netrc (pop3-connection:host-name connection) #f)
(call-error "must provide a login" pop3:login args)))
(password (or (safe-second args)
(netrc:lookup-password netrc (pop3-connection:host-name connection) #f)
(call-error "must provide a password" pop3:login args))))
(with-handler
(lambda (result punt)
(if (-ERR? result)
@ -208,7 +207,7 @@
;; which produces a digest value of
;;
;; c4c9334bac560ecc979e58001b3e22fb
;;
;;
;;: connection x string x string -> status
(define (pop3:login/APOP connection login password)
(let* ((key (string-append (pop3-connection:challenge connection)
@ -331,7 +330,9 @@
;; who will write this in Scheme?
(define (md5-digest str)
(car (run/strings (md5 ,str))))
(car (run/strings (md5sum) (<< ,str))))
; the name of the program differs among the distributions
; e.g. in FreeBSD it is called md5
(define (pop3:dump fd)
(let loop ((line (read-line fd)))