-(defun smtp-auth-cram-md5 (process)
- (let ((secure-word (copy-sequence smtp-authenticate-passphrase))
- response)
- (smtp-send-command process "AUTH CRAM-MD5")
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))
- (smtp-send-command
- process
- (setq secure-word (unwind-protect
- (sasl-cram-md5
- smtp-authenticate-user secure-word
- (base64-decode-string
- (substring (car (cdr response)) 4)))
- (fillarray secure-word 0))
- secure-word (unwind-protect
- (base64-encode-string secure-word)
- (fillarray secure-word 0))) t)
- (fillarray secure-word 0)
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))))
-
-(defun smtp-auth-plain (process)
- (let ((secure-word (copy-sequence smtp-authenticate-passphrase))
- response)
- (smtp-send-command
- process
- (setq secure-word (unwind-protect
- (sasl-plain "" smtp-authenticate-user secure-word)
- (fillarray secure-word 0))
- secure-word (unwind-protect
- (base64-encode-string secure-word)
- (fillarray secure-word 0))
- secure-word (unwind-protect
- (concat "AUTH PLAIN " secure-word)
- (fillarray secure-word 0))) t)
- (fillarray secure-word 0)
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))))
-
-(defun smtp-auth-login (process)
- (let ((secure-word (copy-sequence smtp-authenticate-passphrase))
- response)
- (smtp-send-command process "AUTH LOGIN")
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))
- (smtp-send-command
- process
- (base64-encode-string
- smtp-authenticate-user))
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))
- (smtp-send-command
- process
- (setq secure-word (unwind-protect
- (base64-encode-string secure-word)
- (fillarray secure-word 0))) t)
- (fillarray secure-word 0)
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))))
-
-(defun smtp-auth-anonymous (process &optional token)
- (let (response)
- (smtp-send-command
- process "AUTH ANONYMOUS")
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))
- (smtp-send-command process
- (base64-encode-string
- (or token
- user-mail-address
- "")))
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))))
-
-(defun smtp-auth-scram-md5 (process)
- ;; now tesing
- (let (server-msg-1 server-msg-2 client-msg-1 salted-pass
- response secure-word)
- (smtp-send-command process "AUTH SCRAM-MD5")
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))
- (unwind-protect
- (smtp-send-command
- process
- (setq secure-word
- (base64-encode-string
- (setq client-msg-1
- (sasl-scram-md5-client-msg-1
- smtp-authenticate-user)))) t)
- (fillarray secure-word 0))
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (progn
- (fillarray client-msg-1 0)
- (throw 'done (car (cdr response)))))
- (setq secure-word
- (unwind-protect
- (substring (car (cdr response)) 4)
- (fillarray (car (cdr response)) 0)))
- (setq server-msg-1
- (unwind-protect
- (base64-decode-string secure-word)
- (fillarray secure-word 0)))
- (setq secure-word
- (sasl-scram-md5-client-msg-2
- server-msg-1 client-msg-1
- (setq salted-pass
- (sasl-scram-md5-make-salted-pass
- smtp-authenticate-passphrase server-msg-1))))
- (setq secure-word
- (unwind-protect
- (base64-encode-string secure-word)
- (fillarray secure-word 0)))
- (unwind-protect
- (smtp-send-command process secure-word t)
- (fillarray secure-word 0))
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (progn
- (fillarray salted-pass 0)
- (fillarray server-msg-1 0)
- (fillarray client-msg-1 0)
- (throw 'done (car (cdr response)))))
- (setq server-msg-2
- (unwind-protect
- (base64-decode-string
- (setq secure-word
- (substring (car (cdr response)) 4)))
- (fillarray secure-word 0)))
- (if (null
- (unwind-protect
- (sasl-scram-md5-authenticate-server
- server-msg-1
- server-msg-2
- client-msg-1
- salted-pass)
- (fillarray salted-pass 0)
- (fillarray server-msg-1 0)
- (fillarray server-msg-2 0)
- (fillarray client-msg-1 0)))
- (throw 'done nil))
- (smtp-send-command process "")
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response)))) ))
-
-(defun smtp-auth-digest-md5 (process)
- "Login to server using the AUTH DIGEST-MD5 method."
- (let (user realm response)
- (smtp-send-command process "AUTH DIGEST-MD5")
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))
- (if (string-match "^\\([^@]*\\)@\\([^@]*\\)"
- smtp-authenticate-user)
- (setq user (match-string 1 smtp-authenticate-user)
- realm (match-string 2 smtp-authenticate-user))
- (setq user smtp-authenticate-user
- realm nil))
- (smtp-send-command process
- (base64-encode-string
- (sasl-digest-md5-digest-response
- (base64-decode-string
- (substring (car (cdr response)) 4))
- user
- smtp-authenticate-passphrase
- "smtp" smtp-server realm)
- 'no-line-break) t)
- (setq response (smtp-read-response process))
- (if (or (null (car response))
- (not (integerp (car response)))
- (>= (car response) 400))
- (throw 'done (car (cdr response))))
- (smtp-send-command process "")))
-