diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:06:40 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:06:40 -0800 |
commit | a69c9fb665459e2bfdbda1bf80741a0af31a7faf (patch) | |
tree | f0bc974f8805049e6b9a4e6864886298fbaa05a4 /transact.scm | |
parent | 4684239efa63dc1b2c1cbe37ef7d3062029f5532 (diff) | |
download | slib-5a311b2a623877ed5e6f6dd3ff9f92a2706ff993.tar.gz slib-5a311b2a623877ed5e6f6dd3ff9f92a2706ff993.zip |
New upstream version 3b5upstream/3b5upstream
Diffstat (limited to 'transact.scm')
-rwxr-xr-x[-rw-r--r--] | transact.scm | 10 |
1 files changed, 7 insertions, 3 deletions
diff --git a/transact.scm b/transact.scm index 5dfbeb6..2928e17 100644..100755 --- a/transact.scm +++ b/transact.scm @@ -164,8 +164,11 @@ (define (word:lock! path email) (define lockpath (word-lock:path path)) (define at (substring? "@" email)) - (let ((user (substring email 0 at)) - (hostname (substring email (+ 1 at) (string-length email))) + (define (trim str len) (substring str 0 (min len (string-length str)))) + (let ((user + (trim (substring email 0 at) 15)) + (hostname + (trim (substring email (+ 1 at) (string-length email)) 14)) (oport (open-file lockpath 'wb))) (define userlen (string-length user)) (and oport @@ -199,7 +202,8 @@ (slib:error lockpath 'length pos '(not = 162))) #t)) (let ((certificate (word-lock:certificate lockpath))) - (and (equal? email certificate) email))))) + (and (equal? certificate (string-append user "@" hostname)) + certificate))))) (define (emacs:lock! path email) (define lockpath (emacs-lock:path path)) |