+(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 "")))
+