-
Notifications
You must be signed in to change notification settings - Fork 1
/
maild.cl
244 lines (213 loc) · 7.1 KB
/
maild.cl
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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
;; copyright (C) 2003 Franz Inc, Oakland, CA - All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
;; given in confidence by Franz, Inc. pursuant to a written license
;; agreement, and may be stored and used only in accordance with the terms
;; of such license.
;;
;; Restricted Rights Legend
;; ------------------------
;; Use, duplication, and disclosure of the software, data and information
;; contained herein by any agency, department or entity of the U.S.
;; Government are subject to restrictions of Restricted Rights for
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;
;; $Id: maild.cl,v 1.26 2007/04/12 17:15:02 dancy Exp $
(in-package :user)
(defparameter *configfile* "/etc/maild.cl")
(eval-when (compile eval load)
;; useful when telnet'ing in:
(require :trace))
(defun main (&rest args)
(setf *load-verbose* nil)
;; Ensure sane umask.
(excl.osi:umask #o22)
(let ((prgname (pop args)))
(when (string= (basename prgname) "mailq")
(verify-real-user-is-root)
(queue-list)
(exit 0 :quiet t))
;; Pretend to support 'newaliases'
(when (string= (basename prgname) "newaliases")
(exit 0 :quiet t))
(if (null args)
(error "Recipient names must be specified"))
(with-command-line-arguments
( ;; keep sorted, please
("C" :short alt-config-file :required-companion)
("F" :short fullname :required-companion)
("b" :short runmode :required-companion)
("f" :short from :required-companion)
("i" :short ignoredot nil)
("m" :short metoo nil)
("o" :short options :required-companion :allow-multiple-options)
("p" :short port :required-companion)
("r" :short chroot :required-companion)
("q" :short processqueue :optional-companion)
("T" :short test-mode nil)
("t" :short grab-recips nil)
("v" :short verbose nil))
(cmdline-recips :command-line-arguments args)
(when alt-config-file
(verify-real-user-is-root)
(if (not (probe-file alt-config-file))
(error "Configuration file ~A not found." alt-config-file))
(setf *configfile* alt-config-file))
;; Load the configuration now.
(if (and (probe-file *configfile*)
(verify-root-only-file *configfile*))
(load *configfile*))
;; Override port in config file
(when (and port
(ignore-errors
(setq port (parse-integer port :junk-allowed nil))))
(setq *smtp-port* port))
(when (and chroot (not test-mode))
(error "-r can only be used in test mode."))
(when test-mode
(let ((user (pwent-name (getpwuid (getuid)))))
(setq *test-mode* t)
(setq *test-mode-mailbox*
(format nil "~a/var/spool/mail/~a" chroot user))
(setq *mailers*
`((:local ;; keyword identifier
"Unix mailbox"
lookup-addr-in-passwd
test-deliver-local-command
,user)))))
;; Chroot hack, for testing:
(when chroot
(or (probe-file chroot)
(error "Chroot argument does not exist: ~a." chroot))
(or (file-directory-p chroot)
(error "Chroot argument is not a directory: ~a." chroot))
(dolist (v '(*ssl-certificate-file* *ssl-key-file* *aliases-file*
*stats-file* *queuedir* *pid-file*))
(set v (concatenate 'simple-string
chroot (symbol-value v)))
(format t "debug: ~a=~a~%" v (symbol-value v)))
;;;;more?????
)
;; sanity checks
(if (not (probe-file *queuedir*))
(error "Queue directory ~A doesn't exist!" *queuedir*))
(verify-root-only-file *queuedir*)
(if (and *ssl-support* (null *ssl-certificate-file*))
(error "*ssl-certificate-file* must be set when *ssl-support* is enabled"))
(if (and *client-authentication*
*client-auth-requires-ssl*
(null *ssl-support*))
(error "*ssl-support must be enabled when *client-auth-requires-ssl* is enabled"))
(establish-signal-handlers)
;; process options. Ignores ones which we don't implement
(dolist (option options)
(cond
((string= option "i")
(setf ignoredot t))
((string= option "M")
(setf metoo t))))
(when processqueue
(if (stringp processqueue)
(setf processqueue (parse-queue-interval processqueue))
(setf processqueue 0)))
(when runmode
(cond
((string= runmode "d")
(verify-real-user-is-root)
(smtp-server-daemon :queue-interval processqueue)
(exit 0 :quiet t)) ;; parent gets here.
((string= runmode "D")
(verify-real-user-is-root)
(setf *debug* t)
(smtp-server-daemon :queue-interval processqueue))
((string= runmode "T")
(setf *debug* t)
(smtp-server-daemon :queue-interval processqueue))
((string= runmode "s")
(do-smtp *terminal-io* :fork t :verbose verbose)
(exit 0 :quiet t))
((string= runmode "p")
(verify-real-user-is-root)
(queue-list)
(exit 0 :quiet t))
((string= runmode "v")
(verify-cmdline-addrs cmdline-recips)
(exit 0 :quiet t))
((string= runmode "i")
;; ignore.
(exit 0 :quiet t))
(t
(error "-b~A option invalid" runmode))))
(when processqueue
(verify-real-user-is-root)
(queue-process-all :verbose verbose :max 1)
(exit 0 :quiet t))
(if (and (not grab-recips) (null cmdline-recips))
(error "Recipient names must be specified"))
(let (good-recips)
(dolist (string cmdline-recips)
(setf good-recips
(nconc good-recips
(get-good-recips-from-string string))))
(if (or good-recips grab-recips)
(send-from-stdin good-recips
:dot (if ignoredot nil t)
:gecos fullname
:from from
:grab-recips grab-recips
:metoo metoo
:verbose verbose)
(error "~a: No valid recipients specified." prgname))))))
;; s = seconds
;; m = minutes (default if no tag specified)
;; h = hours
;; d = days
;; w = weeks
(defun parse-queue-interval (string)
(let ((max (length string))
(pos 0)
(seconds 0)
char)
(loop
(when (>= pos max)
(return))
(multiple-value-bind (value newpos)
(parse-integer string :start pos :junk-allowed t)
(when (null value)
(error "Invalid time spec: ~A" string))
;; find out what the units are
(when (>= newpos max)
;; no characters follow. Default to minutes
(incf seconds (* 60 value))
(return))
(setf char (schar string newpos))
(case char
(#\s
(incf seconds value))
(#\m
(incf seconds (* 60 value)))
(#\h
(incf seconds (* 3600 value)))
(#\d
(incf seconds (* 86400 value)))
(#\w
(incf seconds (* (* 86400 7) value)))
(t
(error "Invalid time unit: '~A'" char)))
(setf pos (1+ newpos))))
seconds))
(defun maild-signal-handler (sig tee)
(declare (ignore tee))
(maild-log "Maild terminating on signal ~d" sig)
(excl::mp-safe-exit (+ 128 sig) :quiet t)
t) ;; for good measure
(defun establish-signal-handlers ()
(dolist (sig `(,*sigint* ,*sigterm* ,*sighup*))
(set-signal-handler sig #'maild-signal-handler)))
;; XXX -- sendmail shows the expansions. Will do that
;; later.
(defun verify-cmdline-addrs (strings)
(dolist (string strings)
(get-good-recips-from-string string :verbose t)))