netrc:parse handles following conditions correctly by returning
a default netrc-record: * the specified file does not exist * the file does exist but does not have the correct permissions In both cases a warning is printed on (current-error-port) So, netrc:parse always returns a usable record. If you want to catch the errors use netrc:try-parse
This commit is contained in:
interp
parent
89bb20c63e
commit
f9dc21c767
|
|
@ -533,7 +533,8 @@
|
|||
netrc:lookup-password
|
||||
netrc:lookup-login
|
||||
netrc:parse
|
||||
netrc:try-parse))
|
||||
netrc:try-parse
|
||||
netrc-refuse?))
|
||||
|
||||
(define-structure netrc netrc-interface
|
||||
(open defrec-package
|
||||
|
|
@ -542,7 +543,7 @@
|
|||
error-package
|
||||
ecm-utilities
|
||||
string-lib
|
||||
conditions signals
|
||||
conditions signals handle
|
||||
let-opt
|
||||
scheme)
|
||||
(files netrc))
|
||||
|
|
|
|||
141
netrc.scm
141
netrc.scm
|
|
@ -1,6 +1,6 @@
|
|||
;;; netrc.scm -- parse authentication information contained in ~/.netrc
|
||||
;;
|
||||
;; $Id: netrc.scm,v 1.3 2001/12/18 18:08:08 interp Exp $
|
||||
;; $Id: netrc.scm,v 1.4 2001/12/27 16:45:32 interp Exp $
|
||||
;;
|
||||
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
|
||||
|
||||
|
|
@ -27,7 +27,7 @@
|
|||
;; * The macdef statement (defining macros) is not supported.
|
||||
;; * The settings for one machine must be on a single line.
|
||||
;; * The is no error proof while reading the file.
|
||||
;; * default must not be the last line of the netrc-file
|
||||
;; * default need not be the last line of the netrc-file
|
||||
|
||||
|
||||
|
||||
|
|
@ -36,22 +36,61 @@
|
|||
;; (user-mail-address) -> string
|
||||
;; Calculate the user's email address, as per the Emacs function of
|
||||
;; the same name. Will take into account the environment variable
|
||||
;; REPLYTO, if set.
|
||||
;; REPLYTO, if set. Otherwise the mail-address will look like
|
||||
;; user@hostname.
|
||||
;;
|
||||
;; (netrc:default-login) -> string
|
||||
;; Return the default login specified by the ~/.netrc file or "anonymous"
|
||||
;; (netrc:parse [filename [fallback-password [fallback-login]]])
|
||||
;; -> netrc-record
|
||||
;; * parses the netrc file and returns a netrc-record, containing all
|
||||
;; necessary information for the following procedures.
|
||||
;; * FILENAME defaults to "~/.netrc"
|
||||
;; FALLBACK-PASSWORD defaults to the result of (user-mail-address)
|
||||
;; FALLBACK-LOGIN defaults to "anonymous"
|
||||
;; * if the netrc file does not provide a default password or a default
|
||||
;; login (stated by the "default" statement), FALLBACK-PASSWORD and
|
||||
;; FALLBACK-LOGIN will be used as default password or login, respectively.
|
||||
;; (thus, user-mail-address is only called if the netrc file does not
|
||||
;; contain a default specification)
|
||||
;; * if the netrc file does not exist, a netrc-record filled with
|
||||
;; default values is returned.
|
||||
;; * if the netrc file does not have the correct permissions, a message is
|
||||
;; printed to current error port and a netrc-record filled with default
|
||||
;; values is returned.
|
||||
;;
|
||||
;; (netrc:default-password) -> string
|
||||
;; Return the default password specified by the ~/.netrc file or
|
||||
;; to the mail-addres (result of (user-mail-address))
|
||||
;; (netrc:try-parse filename fallback-password fallback-login) -> netrc-record
|
||||
;; parses the netrc file and returns a netrc-record, containing all
|
||||
;; necessary information for the following procedures.
|
||||
;; if there is no file called FILENAME, the according error will be raised
|
||||
;; if the specified file does not have the correct permissions set,
|
||||
;; a netrc-refuse-warning will be signalled.
|
||||
;; so if you don't like the error handling of netrc:parse, use
|
||||
;; netrc:try-parse and catch the signalled conditions.
|
||||
;;
|
||||
;; (netrc:lookup machine) -> string x string x string
|
||||
;; (netrc:lookup netrc-record machine [default?]) -> string x string x string
|
||||
;; Return the login,password,account information for MACHINE
|
||||
;; specified by the ~/.netrc file.
|
||||
;; If there is no such machine specified, the condition 'netrc:no-such-entry
|
||||
;; is signalled, that can be caught with with-handler.
|
||||
;; If you catch this signal, you probably want to use netrc:default-login
|
||||
;; and netrc:default-password, that are always set to usable values.
|
||||
;; specified by the netrc file.
|
||||
;; If DEFAULT? is #t, default values are returned if no such
|
||||
;; MACHINE is specified in the netrc file. Otherwise, #f,#f,#f
|
||||
;; is returned
|
||||
;;
|
||||
;; (netrc:lookup-password netrc-record machine [default?]) -> string
|
||||
;; Return the password information for MACHINE specified by the
|
||||
;; netrc file.
|
||||
;; If DEFAULT? is #t, the default password is returned if no such
|
||||
;; MACHINE is specified. Otherwise, #f is returned.
|
||||
;;
|
||||
;; (netrc:lookup-login netrc-record machine [default?]) -> string
|
||||
;; Return the login information for MACHINE specified by the
|
||||
;; netrc file.
|
||||
;; If DEFAULT? is #t, the default login is returned if no such
|
||||
;; MACHINE is specified. Otherwise, #f is returned.
|
||||
;;
|
||||
;; (netrc:default-login netrc-record) -> string
|
||||
;; Return the default login specified by the netrc file or "anonymous"
|
||||
;;
|
||||
;; (netrc:default-password netrc-record) -> string
|
||||
;; Return the default password specified by the netrc file or
|
||||
;; the mail-addres (result of (user-mail-address))
|
||||
|
||||
|
||||
|
||||
|
|
@ -61,7 +100,7 @@
|
|||
;; Netrc.pm
|
||||
;;
|
||||
;; * ange-ftp.el (transparent remote file access for Emacs) parses the
|
||||
;; user's ~/.netrc file
|
||||
;; user's netrc file
|
||||
|
||||
|
||||
;;; Portability ==================================================
|
||||
|
|
@ -74,9 +113,12 @@
|
|||
;;
|
||||
;; * Remove restrictions (as stated in 'Overview') and behave like
|
||||
;; /usr/bin/ftp behaves
|
||||
;; * perhaps: adding case-insensitivity
|
||||
;; * perhaps: adding case-insensitivity (for host names)
|
||||
;; * perhaps: better record-disclosers for netrc-entry- and netrc-records
|
||||
|
||||
|
||||
; return the user's mail address, either specified by the environment
|
||||
; variable REPLYTO or "user@hostname".
|
||||
(define (user-mail-address)
|
||||
(or (getenv "REPLYTO")
|
||||
(string-append (user-login-name) "@" (system-fqdn))))
|
||||
|
|
@ -98,7 +140,7 @@
|
|||
(values (netrc-entry:login record)
|
||||
(netrc-entry:password record)
|
||||
(netrc-entry:account record))
|
||||
(and lookup-default?
|
||||
(if lookup-default?
|
||||
(values (netrc:default-login netrc-record)
|
||||
(netrc:default-password netrc-record)
|
||||
#f)
|
||||
|
|
@ -141,38 +183,70 @@
|
|||
; default-login: default login name for any not specified machine
|
||||
; defaults to "anonymous"
|
||||
; default login in netrc-file overwrites this setting
|
||||
; (default-login is expected after default-password as users usually want
|
||||
; * (default-login is expected after default-password as users usually want
|
||||
; to change the default-password (to something else than their mail-address)
|
||||
; rather than the login-name)(define (netrc:parse . args)
|
||||
; if the given file does not exist, than a default netrc-record is returned
|
||||
; if you don't want this, use netrc:try-parse; note that you have to
|
||||
; resolve the file-name on your own
|
||||
; * if the given file does not exist or it has the wrong permissions,
|
||||
; than a default netrc-record is returned
|
||||
; * if you don't want expected errors to be captured, use netrc:try-parse;
|
||||
; note that you have to resolve the file-name on your own
|
||||
(define-condition-type 'netrc-refuse '(warning))
|
||||
(define netrc-refuse? (condition-predicate 'netrc-refuse))
|
||||
|
||||
(define (netrc:parse . args)
|
||||
(let-optionals
|
||||
args ((file-name "~/.netrc")
|
||||
(default-password #f) ; both ...
|
||||
(default-login #f)) ; ... are set if netrc-file does not provide default-values
|
||||
(let ((file-name (resolve-file-name file-name)))
|
||||
(default-login #f)) ; ... are set if netrc-file does
|
||||
; not provide default-values
|
||||
(let* ((file-name (resolve-file-name file-name))
|
||||
(local-default-login (lambda () "anonymous"))
|
||||
(local-default-password (lambda () (user-mail-address)))
|
||||
(local-default-netrc-record
|
||||
(lambda ()
|
||||
(make-netrc '()
|
||||
(or default-login (local-default-login))
|
||||
(or default-password (local-default-password))
|
||||
#f))))
|
||||
; i know, this double-handler sucks; has anyone a better idea?
|
||||
(call-with-current-continuation
|
||||
(lambda (exit)
|
||||
(with-handler
|
||||
(lambda (error more)
|
||||
(if (netrc-refuse? error)
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
"netrc: Warning: ~a~%"
|
||||
(car (condition-stuff error)))
|
||||
(exit (local-default-netrc-record)))))
|
||||
(lambda ()
|
||||
(with-errno-handler*
|
||||
(lambda (errno packet)
|
||||
(if (= errno errno/noent)
|
||||
(exit (make-netrc '()
|
||||
(or default-login "anonymous")
|
||||
(or default-password (user-mail-address))
|
||||
#f))))
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
"netrc: Warning: no such file or directory: ~a~%"
|
||||
file-name)
|
||||
(exit (local-default-netrc-record)))))
|
||||
(lambda ()
|
||||
(let ((netrc-record (netrc:try-parse file-name default-password default-login)))
|
||||
(let ((netrc-record
|
||||
(netrc:try-parse file-name default-password default-login)))
|
||||
(if netrc-record
|
||||
netrc-record
|
||||
(begin
|
||||
(set-netrc:default-password netrc-record (or default-password (user-mail-address)))
|
||||
(set-netrc:default-login netrc-record (or default-login "anonymous"))
|
||||
netrc-record))))))))))
|
||||
(set-netrc:default-password
|
||||
netrc-record
|
||||
(or default-password (local-default-password)))
|
||||
(set-netrc:default-login
|
||||
netrc-record
|
||||
(or default-login (local-default-login)))
|
||||
netrc-record))))))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; nothing exported below
|
||||
;; except
|
||||
;; netrc:default-password
|
||||
;; netrc:default-login
|
||||
|
||||
(define-record netrc-entry
|
||||
machine
|
||||
|
|
@ -209,7 +283,10 @@
|
|||
(define (netrc:check-permissions file-name)
|
||||
(let ((perms (- (file-mode file-name) 32768)))
|
||||
(if (positive? (bitwise-and #b000111111 perms))
|
||||
(error "Not parsing ~/.netrc file; dangerous permissions."))))
|
||||
(signal 'netrc-refuse
|
||||
(format #f
|
||||
"Not parsing ~s (netrc file); dangerous permissions."
|
||||
file-name)))))
|
||||
|
||||
; tries to match target on line and returns the first group,
|
||||
; or #f if there is no match
|
||||
|
|
|
|||
Loading…
Reference in New Issue