Emacs Double Opt-In CGI Skeleton Script

;;; double-opt-in.el --- Emacs Double Opt-In CGI
;; #!/usr/bin/env -S emacs --script

;; Copyright (C) 2021 by Jean Louis

;; Author: Jean Louis <bugs@gnu.support>
;; Version: 0.1
;; Package-Requires: (rcd-mail url)
;; Keywords: comm
;; URL: https://hyperscope.link/3/9/1/4/3/Emacs-Double-Opt-In-CGI-Skeleton-Script-39143.html

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program 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 GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;  This is Emacs Double Opt-In CGI Skeleton Script. It is your sales
;; and marketing tool for the World Wide Web. Subscribe users, let
;; them confirm the subscription by clicking on the hyperlink in the
;; email, let them unsubscribe when necessary. Use this script to
;; avoid the subscription spam on your websites. This CGI script is
;; completely Emacs based. It requires no database. It dispatches
;; subscription and unsubscription requests by e-mail as attached
;; files containin the Emacs Lisp hash with the subscription,
;; confirmation or unsubscription data.

;; ℹ HOW TO INSTALL?
;; ━━━━━━━━━━━━━━━━━━
;;
;; 1. To run this script as CGI, include as first line the shebang line:
;; #!/usr/bin/env emacs --script
;;
;; 2. Make it executable and configure your WWW server to run CGI.
;;
;; 3. Make sure to rename it to have a proper extension, like ".cgi"

;; ⚠ SECURITY ISSUES
;; ━━━━━━━━━━━━━━━━━━
;;
;; ❰    ❱ PGP encryption of attached files will be enabled later.
;;
;; ❰    ❱ Is it important that redirection URLs are in the URL
;; parameters?  I don't think so. If anybody wish to deconstruct such
;; hyperlinks they may do so and inspect it themselves. I think there
;; is no need to hide the redirection URLs. People are either sold for
;; your services or products and wish to subscribe or not. Work on
;; selling, not on dark patterns and digital online manipulations.
;;
;; ❰DONE❱ By customizing the security PIN one may prevent the abuse of
;; this script, as then only the administrator knows how to construct
;; the MD5 hash.

;; ☑ INSTRUCTIONS
;; ━━━━━━━━━━━━━━━
;;
;; 1. Create a subscription HTML form with following fields:
;;    - "name" as text field visible to public
;;    - "email" as text field visible to public
;;    - "mid" as hidden field, meaning the Mailing list ID
;;    - "action" as hidden field, must be SUBSCRIBE
;;    - "redirect" as hidden field, should be your subscription confirmation page
;;    - "confirmed-redirect" as as hidden field, as that is where
;;       people will move after confirmation
;;
;; Send a GET request:
;; https://www.example.com/double-opt-in.cgi?name=NAME&email=EMAIL&mid=MID&action=SUBSCRIBE&redirect=http://confirm.com/html
;;
;; TODO maybe it shall be fixed to POST request.
;;
;; Redirect to confirmation page or sales page, or confirmation that
;; redirects to sales page.
;;
;; Person receives email with the double opt-in request. User clicks
;; on the email or not. Redirect page should be in the link. This is
;; generic program as for now. TODO. It may become specific later.
;;
;; 2. Create a HTML confirmation page as that is where people will get
;;    confirmation when they click on the double opt-in hyperlink in
;;    their email message. The HTML confirmation page could or should
;;    redirect people further to some other page like sales page or
;;    similar.
;;
;; 3. Create a HTML page to confirm the unsubscribe request of a
;; user. Don't bother user, user has already clicked. Unsubscribe user
;; and offer to user on the same confirmation page to subscribe
;; again. Redirect user again to sales page or similar.
;;
;; 4. Administrator receives Emacs Lisp hash file that is then
;; processed offline. Person is subscribed to specific mailing list
;; or unsubscribed. Database need not be held online.
;;
;; 5. Your offline mailing list system has to construct unsubscription
;; hyperlinks. The unsubscription request arrives by email to
;; administrator in form of the attached Emacs Lisp hash file and is
;; processed offline automatically.
;;

;;; Change Log:

;;; Code:

(add-to-list 'load-path doi-load-path)
(require 'rcd-mail)
(require 'url)

;;;; Variables

(defcustom doi-home "/home/data1/protected"
  "Default Double Opt-In $HOME"
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-load-path "/home/data1/protected/Programming/emacs-lisp/"
  "Default Double Opt-In load path where all required libraries reside."
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-general-redirection-url "https://www.example.com"
  "Default Double Opt-In general redirection URL when nothing else works."
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-to-email "bugs@example.com"
  "Default Double Opt-In recipient's email address"
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-to-name "Double Opt-In"
  "Default Double Opt-In recipient's name"
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-from-email "bugs@gnu.support"
  "Default Double Opt-In sender's email address"
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-from-name "Double Opt-In"
  "Default Double Opt-In sender's name"
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-sendmail "/home/admin/bin/sendmail"
  "Default Double Opt-In sendmail program path"
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-subject-prefix "Double Opt-In: "
  "Default Double Opt-In subject prefix"
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-directory "/home/data1/protected/public_html/doi/"
  "Double Opt-In directory to save requests."
    :group 'Double-Opt-In
    :type 'string)

(defcustom doi-pin ""
  "Double Opt-In security PIN for MD5 hash generation."
    :group 'Double-Opt-In
    :type 'string)

(unless (file-exists-p doi-directory)
  (make-directory doi-directory t))

(defvar doi-actions '("SUBSCRIBE" "CONFIRM" "UNSUBSCRIBE")
  "Possible actions for Double Opt-In.")

(defvar doi-substring-to 3
  "The TO parameter for function `substring' used in the package.")

(defvar doi-debug t
  "Enable variable `doi-debug' to get some meaningful messages.")

(setq debug-on-error nil)
(setq debug-on-quit nil)

;;;; RCD Utilities

(defun rcd-cgi-headers (&optional content-type)
  "Prints basic HTTP headers for HTML"
  (let ((content-type (or content-type "text/html")))
    (princ (format "Content-type: %s\n\n" content-type))))

(defun rcd-cgi-message (message &optional title dont-kill)
  "Return message over HTTP."
  (let ((title (or title "information")))
    (rcd-cgi-headers "text/plain")
    (princ (rcd-report-underlined title message))
    (unless (or dont-kill (eq major-mode 'emacs-lisp-mode))
      (kill-emacs 0))))

(defun rcd-cgi-redirect (url)
  "Redirect to URL."
  (princ (concat "Location: " url "\n\n"))
  (unless (eq major-mode 'emacs-lisp-mode)
    (kill-emacs 0)))

(defun string-to-file-force (string file)
  "Prints string into file, matters not if file exists. Returns FILE as file name."
  (with-temp-file file
    (insert string))
  file)

(defun file-to-string (file)
  "File to string function"
  (with-temp-buffer
    (insert-file-contents file)
    (buffer-string)))

(defun data-to-file (data file)
  "PRIN1 Emacs Lisp DATA to FILE"
  (string-to-file-force (prin1-to-string data) file))

(defun data-from-file (file)
  "Reads and returns Emacs Lisp data from FILE"
  (car
   (read-from-string
    (file-to-string file))))

;;;; Double Opt-In Functions

(defun doi-send-mail (subject text)
  "Easy sending emails for Double Opt-In"
  (rcd-mailutils-mail text subject doi-from-name doi-from-email doi-to-name doi-to-email
		      nil nil nil doi-sendmail))

(defun doi-file-find (md5)
  "Return existing MD5 file for Double Opt-In.confirmation or NIL."
  (let ((file (concat (file-name-as-directory doi-directory)
		      (file-name-as-directory (substring md5 0 doi-substring-to))
		      md5)))
    (if (file-exists-p file) file nil)))

(defun doi-file (name email phone mid ip action)
  "Return file name for NAME, EMAIL, PHONE, MID, IP and ACTION."
  (let* ((md5 (md5 (format "%s %s %s %s %s %s" name email phone mid ip action)))
	 (directory (concat (file-name-as-directory doi-directory)
			    (file-name-as-directory (substring md5 0 doi-substring-to))))
	 (file (concat directory md5)))
    file))

(defun doi-hash (name email phone mid ip action &optional eid cid md5 redirect)
  "Return hash for NAME, EMAIL, PHONE, MID, IP and ACTION.

EID, CID and MD5 are optional."
  (when (member action doi-actions)
    (let ((hash (make-hash-table :test #'equal)))
      (puthash "name" name hash)
      (puthash "email" email hash)
      (puthash "phone" phone hash)
      (puthash "mid" mid hash)
      (puthash "ip" ip hash)
      (puthash "action" action hash)
      (when eid (puthash "eid" eid hash))
      (when cid (puthash "cid" cid hash))
      (when md5 (puthash "md5" md5 hash))
      (when redirect (puthash "redirect" redirect hash))
      hash)))

;;;; Hash verification and generation

(defun doi-hash-verify (mid eid cid md5 &optional pin)
  "Return MD5 hash for MID, EID, CID and MD5."
  (when (string-equal md5 (doi-hash-generate mid eid cid pin)) t))

(defun doi-hash-generate (mid eid cid &optional pin)
  "Generate MD5 hash for MID, EID and CID"
  (md5 (format "%s %s %s %s" mid eid cid pin)))

;;;; Subscribe request

(defun doi-subscribe-request (hash)
  "Save request for HASH"
  (let* ((name (gethash "name" hash))
	 (email (gethash "email" hash))
	 (mid (gethash "mid" hash))
	 (phone (gethash "phone" hash))
	 (ip (gethash "ip" hash))
	 (action (gethash "action" hash))
	 (redirect (gethash "redirect" hash)))
    (if (and (member action doi-actions)
	     name email mid ip)
	(let* ((file (doi-file name email phone mid ip action))
	       (md5 (file-name-nondirectory file))
	       (directory (file-name-directory file))
	       (file-exists (file-exists-p file)))
	  (puthash "doi-file" file hash)
	  (puthash "md5" md5 hash)
	  (make-directory directory t)
	  (when file-exists
	    (doi-send-mail "WARNING: Repeated subscribe request"
			   (format "Subscription request `%s' repeated from IP: %s" md5 ip)))
	  (data-to-file hash file)
	  (doi-send-confirmation-hyperlink hash)
	  (rcd-cgi-redirect redirect))
      (rcd-cgi-message "Could not make subscribe request"))))

(defun doi-send-confirmation-hyperlink (hash)
  (let* ((md5 (gethash "md5" hash))
	 (action "CONFIRM")
	 (mid (gethash "mid" hash))
	 (redirect (gethash "confirmed-redirect" hash))
	 (server-name "localhost") ;; (getenv "SERVER_NAME")) TODO
	 (script-name (getenv "SCRIPT_NAME"))
	 (hyperlink (format "http://%s%s?md5=%s&action=%s&redirect=%s&mid=%s" server-name script-name md5 action redirect mid))
	 (text (rcd-report-underlined "Confirm your subscription" (format "To confirm your subscription please click on the following hyperlink:\n\n%s\n\nThank you." hyperlink))))
    (doi-send-mail "Confirm your subscription" text)))


;;;; Confirm

;; TODO verify email domain part to be valid with valid MX record.
;; Verify email to look as valid email
;; Verify string sizes not to be as large

(defun doi-confirm-subscription (md5 redirect mid)
  "Confirm subscription and send file MD5 by email to administrator."
  (let ((file (doi-file-find md5)))
    (if file
      (let ((subject (concat doi-subject-prefix "Subscription Confirmation" ))
	    (text (concat "Double Opt-In Subscription Confirmation File: " md5)))
	(rcd-mailutils-mail text subject doi-from-name doi-from-email doi-to-name doi-to-email
			    nil nil nil doi-sendmail file)
	(rcd-cgi-redirect redirect))
      (rcd-cgi-message (format "Cannot find file `%s'" md5)))))

;;;; Unsubscribe for real

(defun doi-unsubscribe (mid eid cid md5 ip redirect)
  (if (doi-hash-verify mid eid cid md5)
    (let* ((subject (concat doi-subject-prefix "Unsubscribe Request"))
	   (text (concat "Double Opt-In Unsubscription: " md5))
	   (hash (doi-hash "" "" "" mid ip "UNSUBSCRIBE" eid cid md5 redirect))
	   (file (md5 (format "%s %s %s %s %s %s" mid eid cid md5 ip redirect)))
	   (directory (concat (file-name-as-directory doi-directory)
			      (file-name-as-directory "unsubscribe")
			      (substring md5 0 doi-substring-to)))
	   (file (concat (file-name-as-directory directory) file))
	   (_ (make-directory directory t))
	   (file (data-to-file hash file)))
      (if (file-exists-p file)
	  (progn
	    (rcd-mailutils-mail text subject doi-from-name doi-from-email doi-to-name doi-to-email
	     			nil nil nil doi-sendmail file)
	    (rcd-cgi-redirect redirect))
	(rcd-cgi-message "Cannot create file, write to administrator")))
    (progn
      (doi-send-mail "DOI: Bad unsubscribe request" (shell-command-to-string "set"))
      (rcd-cgi-message
       (format "Sorry your unsubscribe request cannot be confirmed and your IP %s has been reported." ip)))))

;;;; Delete

(defun doi-delete (md5)
  "Delete Double Opt-In file MD5"
  (let ((file (doi-file-find md5)))
    (when file
      (delete-file file))))

;;;; Parse

(defun doi-parse-query-to-hash (query-string)
  "Parse QUERY-STRING that normally comes from the environment
variable `QUERY_STRING'. Return hash."
  (let* ((query-string (url-unhex-string query-string))
	 (parts (split-string query-string "&"))
	 (length (length parts))
	 (hash (make-hash-table :test #'equal)))
    (while parts
      (let* ((data (split-string (pop parts) "="))
	     (variable (car data))
	     (value (cadr data)))
	(puthash variable value hash)))
    hash))

;;;; Accept requests

(defun doi-lead ()
  (setf (getenv "HOME") doi-home)
  (let ((method (getenv "REQUEST_METHOD")))
    (when (string= method "GET")
      (let* ((query-string (getenv "QUERY_STRING"))
	     (ip (getenv "REMOTE_ADDR"))
	     (hash (doi-parse-query-to-hash query-string)))
	(puthash "ip" ip hash)
	(if (and (member (gethash "action" hash) doi-actions)
		 (gethash "redirect" hash) (gethash "mid" hash) (gethash "ip" hash))
	    (cond
	     ;; Unsubscribe
	     ((and (gethash "eid" hash) (gethash "cid" hash) (gethash "md5" hash) (gethash "redirect" hash)
		   (string-equal (gethash "action" hash) "UNSUBSCRIBE"))
	      (doi-unsubscribe (gethash "mid" hash) (gethash "eid" hash) (gethash "cid" hash)
			       (gethash "md5" hash) (gethash "ip" hash) (gethash "redirect" hash)))

	     ;; Confirm subscription
	     ((and (gethash "md5" hash) (stringp (gethash "action" hash)) (gethash "redirect" hash)
		   (string-equal (gethash "action" hash) "CONFIRM"))
	      (doi-confirm-subscription (gethash "md5" hash) (gethash "redirect" hash) (gethash "mid" hash)))

	     ;; Subscribe request
	     ((and (gethash "name" hash) (gethash "email" hash) (gethash "mid" hash)
		   (string-equal (gethash "action" hash) "SUBSCRIBE") (gethash "confirmed-redirect" hash))
	      (doi-subscribe-request hash))

	     ;; Default
	     (t (rcd-cgi-redirect doi-general-redirection-url)))
	  (rcd-cgi-redirect doi-general-redirection-url))))))

(doi-lead)

(provide 'double-opt-in)

;;; doubleoptin.el ends here