summaryrefslogtreecommitdiffstats
path: root/auth.txr
blob: 3820f6a4f4bd0cf71ae7aa283224410c85a518f7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
@(do
   (defun put-binary-str (str stream)
     (let ((len (length str)))
       (put-byte (trunc len 256) stream)
       (put-byte (mod len 256) stream)
       (put-string str stream)))

   (defun sasl-auth (user pass)
     (let ((sock (open-socket af-unix sock-stream)))
       (sock-connect sock (new sockaddr-un path sasl-sock))
       (put-binary-str user sock)
       (put-binary-str pass sock)
       (put-binary-str "" sock)
       (put-binary-str "" sock)
       (let ((response (get-string sock)))
         (equal [response 2..4] "OK")))))
@(define auth (userid password))
@  (local s)
@  (if (eq auth :sasl))
@    (require (sasl-auth userid password))
@  (elif (eq auth :imap))
@    (try)
@      (bind s @(let ((sock (open-socket af-inet sock-stream "i")))
                  (sock-connect sock (new sockaddr-in
                                          addr inaddr-loopback
                                          port 143))
                  (sock-recv-timeout sock (* 30 1000000))))
@      (next s)
* OK@(skip)
@      (output s)
A0001 LOGIN @userid @password@\r
@      (end)
@      (repeat :gap 0)
* @(skip)
@      (end)
@      (cases)
A0001 OK@(skip)
@        (accept)
@      (or)
A0001 NO@(skip)
@        (fail)
@      (end)
@    (catch timeout-error)
@      (fail)
@    (end)
@  (else)
@    (throw error "misconfigured: auth must be :imap or :sasl")
@  (end)
@(end)