<commit_before>;;; -*- mode: Lisp -*-
	
;;; This file is part of CL-SMTP, the Lisp SMTP Client

;;; Copyright (C) 2004/2005/2006/2007 <NAME>

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the Lisp Lesser General Public License
;;; (http://opensource.franz.com/preamble.html), known as the LLGPL.

;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; Lisp Lesser GNU General Public License for more details.

;;; File: cl-smtp.lisp
;;; Description: main smtp client logic

(in-package :cl-smtp)

(defparameter *content-type* "text/plain; charset=ISO-8859-1")

(defparameter *x-mailer* (format nil "(~A ~A)" 
				 (lisp-implementation-type)
				 (lisp-implementation-version)))

(defun check-arg (arg name)
  (cond
   ((or (stringp arg)
        (pathnamep arg))
    (list arg))
   ((listp arg)
    arg)
   (t
    (error "the \"~A\" argument is not a string or cons" name))))

(defun mask-dot (str)
  "replace \r\n.\r\n with \r\n..\r\n"
  (let ((dotstr (format nil "~C~C.~C~C" #\Return #\NewLine
			#\Return #\NewLine))
	(maskdotsr (format nil "~C~C..~C~C" #\Return #\NewLine
			#\Return #\NewLine))
	(resultstr ""))
    (labels ((mask (tempstr)
	       (let ((n (search dotstr tempstr)))
		 (cond
		  (n
		   (setf resultstr (concatenate 'string resultstr 
						(subseq tempstr 0 n)
						maskdotsr))
		   (mask (subseq tempstr (+ n 5))))
		  (t
		   (setf resultstr (concatenate 'string resultstr 
						tempstr)))))))
      (mask str))
    resultstr))

(defun string-to-base64-string (str)
  (declare (ignorable str))
  #+allegro (excl:string-to-base64-string str)
  #-allegro (cl-base64:string-to-base64-string str))


(defun send-email (host from to subject message 
		   &key (port 25) cc bcc reply-to extra-headers
			html-message display-name authentication
			attachments (buffer-size 256))
  (send-smtp host from (check-arg to "to") subject (mask-dot message)
	     :port port :cc (check-arg cc "cc") :bcc (check-arg bcc "bcc")
	     :reply-to reply-to 
	     :extra-headers extra-headers
	     :html-message html-message
	     :display-name display-name
	     :authentication authentication
	     :attachments (check-arg attachments "attachments")
	     :buffer-size (if (numberp buffer-size) 
			      buffer-size
			    256)))


(defun send-smtp (host from to subject message 
		  &key (port 25) cc bcc reply-to extra-headers html-message 
		       display-name authentication attachments buffer-size)
  (let* ((sock (usocket:socket-stream (usocket:socket-connect host port)))
	 (boundary (make-random-boundary))
	 (html-boundary (if (and attachments html-message)
			    (make-random-boundary)
			    boundary)))
    (unwind-protect
	(progn
	  (open-smtp-connection sock :authentication authentication)
	  (send-smtp-headers sock :from from :to to :cc cc :bcc bcc :reply-to reply-to :display-name display-name :extra-headers extra-headers :subject subject)
	  (send-multipart-headers 
	   sock :attachment-boundary (when attachments boundary) 
	   :html-boundary html-boundary)
	  ;;----------- Send  the body Message ---------------------------
          ;;--- Send the proper headers depending on plain-text, <commit_msg>don't set multipart header when send pure text message<commit_after>;;; -*- mode: Lisp -*-
	
;;; This file is part of CL-SMTP, the Lisp SMTP Client

;;; Copyright (C) 2004/2005/2006/2007 <NAME>

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the Lisp Lesser General Public License
;;; (http://opensource.franz.com/preamble.html), known as the LLGPL.

;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; Lisp Lesser GNU General Public License for more details.

;;; File: cl-smtp.lisp
;;; Description: main smtp client logic

(in-package :cl-smtp)

(defparameter *content-type* "text/plain; charset=ISO-8859-1")

(defparameter *x-mailer* (format nil "(~A ~A)" 
				 (lisp-implementation-type)
				 (lisp-implementation-version)))

(defun check-arg (arg name)
  (cond
   ((or (stringp arg)
        (pathnamep arg))
    (list arg))
   ((listp arg)
    arg)
   (t
    (error "the \"~A\" argument is not a string or cons" name))))

(defun mask-dot (str)
  "replace \r\n.\r\n with \r\n..\r\n"
  (let ((dotstr (format nil "~C~C.~C~C" #\Return #\NewLine
			#\Return #\NewLine))
	(maskdotsr (format nil "~C~C..~C~C" #\Return #\NewLine
			#\Return #\NewLine))
	(resultstr ""))
    (labels ((mask (tempstr)
	       (let ((n (search dotstr tempstr)))
		 (cond
		  (n
		   (setf resultstr (concatenate 'string resultstr 
						(subseq tempstr 0 n)
						maskdotsr))
		   (mask (subseq tempstr (+ n 5))))
		  (t
		   (setf resultstr (concatenate 'string resultstr 
						tempstr)))))))
      (mask str))
    resultstr))

(defun string-to-base64-string (str)
  (declare (ignorable str))
  #+allegro (excl:string-to-base64-string str)
  #-allegro (cl-base64:string-to-base64-string str))


(defun send-email (host from to subject message 
		   &key (port 25) cc bcc reply-to extra-headers
			html-message display-name authentication
			attachments (buffer-size 256))
  (send-smtp host from (check-arg to "to") subject (mask-dot message)
	     :port port :cc (check-arg cc "cc") :bcc (check-arg bcc "bcc")
	     :reply-to reply-to 
	     :extra-headers extra-headers
	     :html-message html-message
	     :display-name display-name
	     :authentication authentication
	     :attachments (check-arg attachments "attachments")
	     :buffer-size (if (numberp buffer-size) 
			      buffer-size
			    256)))


(defun send-smtp (host from to subject message 
		  &key (port 25) cc bcc reply-to extra-headers html-message 
		       display-name authentication attachments buffer-size)
  (let* ((sock (usocket:socket-stream (usocket:socket-connect host port)))
	 (boundary (make-random-boundary))
	 (html-boundary (if (and attachments html-message)
			    (make-random-boundary)
			    boundary)))
    (unwind-protect
	(progn
	  (open-smtp-connection sock :authentication authentication)
	  (send-smtp-headers sock :from from :to to :cc cc :bcc bcc :reply-to reply-to :display-name display-name :extra-headers extra-headers :subject subject)
	  (when (or attachments html-message)
	    (send-multipart-headers 
	     sock :attachment-boundary (when attachments boundary) 
	     :html-boundary html-boundary))
	  ;;----------- Send  the body Message ---------------------------
          ;;--- Send the proper headers depending on plain-text, 
{'fraction_non_alphanumeric': 0.14156938081867887, 'fraction_numerical': 0.012117629673415103, 'mean_word_length': 3.0746538229981937, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7503626', 'n_tokens_mistral': 2428, 'n_tokens_neox': 2140, 'n_words': 692}