~ubuntu-branches/ubuntu/trusty/semi/trusty : revision 1

1

;;; smime.el --- S/MIME interface.

2

3

4

5

;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>

6

;; Created: 1999/12/08

7

;; Keywords: S/MIME, OpenSSL

8

9

;; This file is part of SEMI (Secure Emacs MIME Interface).

10

11

;; This program is free software; you can redistribute it and/or

12

;; modify it under the terms of the GNU General Public License as

13

;; published by the Free Software Foundation; either version 2, or (at

14

;; your option) any later version.

15

16

;; This program is distributed in the hope that it will be useful, but

17

;; WITHOUT ANY WARRANTY; without even the implied warranty of

18

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU

19

;; General Public License for more details.

20

21

;; You should have received a copy of the GNU General Public License

22

;; along with GNU Emacs; see the file COPYING. If not, write to the

23

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,

24

;; Boston, MA 02111-1307, USA.

25

26

27

;;; Commentary:

28

29

;; This module is based on

30

31

;; [SMIMEV3] RFC 2633: "S/MIME Version 3 Message Specification"

32

;; by Crocker, D., Flanigan, B., Hoffman, P., Housley, R.,

33

;; Pawling, J. and Schaad, J. (1999/06)

34

35

;; [SMIMEV2] RFC 2311: "S/MIME Version 2 Message Specification"

36

;; by Dusse, S., Hoffman, P., Ramsdell, B., Lundblade, L.

37

;; and L. Repka. (1998/03)

38

39

;;; Code:

40

41

(require 'path-util)

42

(require 'mel)

43

;; binary-funcall, binary-write-decoded-region, binary-insert-encoded-file

44

(eval-when-compile (require 'static))

45

46

(defgroup smime ()

47

"S/MIME interface"

48

:group 'mime)

49

50

(defcustom smime-program "smime"

51

"The S/MIME executable."

52

:group 'smime

53

:type 'string)

54

55

(defcustom smime-shell-file-name "/bin/sh"

56

"File name to load inferior shells from. Bourne shell or its equivalent

57

\(not tcsh) is needed for \"2>\"."

58

:group 'smime

59

:type 'string)

60

61

(defcustom smime-shell-command-switch "-c"

62

"Switch used to have the shell execute its command line argument."

63

:group 'smime

64

:type 'string)

65

66

(defcustom smime-x509-program

67

(let ((file (exec-installed-p "openssl")))

68

(and file (list file "x509" "-noout")))

69

"External program for x509 parser."

70

:group 'smime

71

:type 'string)

72

73

(defcustom smime-cache-passphrase t

74

"Cache passphrase."

75

:group 'smime

76

:type 'boolean)

77

78

(defcustom smime-certificate-directory "~/.w3/certs"

79

"Certificate directory."

80

:group 'smime

81

:type 'directory)

82

83

(defcustom smime-public-key-file nil

84

"Public key file."

85

:group 'smime

86

:type 'boolean)

87

88

(defcustom smime-private-key-file nil

89

"Private key file."

90

:group 'smime

91

:type 'boolean)

92

93

(defvar smime-errors-buffer " *S/MIME errors*")

94

(defvar smime-output-buffer " *S/MIME output*")

95

96

;;; @ utility functions

97

;;;

98

(put 'smime-process-when-success 'lisp-indent-function 0)

99

100

(defmacro smime-process-when-success (&rest body)

101

`(with-current-buffer smime-output-buffer

102

(if (zerop (buffer-size)) nil ,@body t)))

103

104

(defvar smime-passphrase-cache-expiry 16)

105

(defvar smime-passphrase-cache (make-vector 7 0))

106

107

(defvar smime-read-passphrase nil)

108

(defun smime-read-passphrase (prompt &optional key)

109

(if (not smime-read-passphrase)

110

(if (functionp 'read-passwd)

111

(setq smime-read-passphrase 'read-passwd)

112

(if (load "passwd" t)

113

(setq smime-read-passphrase 'read-passwd)

114

(autoload 'ange-ftp-read-passwd "ange-ftp")

115

(setq smime-read-passphrase 'ange-ftp-read-passwd))))

116

(or (and smime-cache-passphrase

117

(symbol-value (intern-soft key smime-passphrase-cache)))

118

(funcall smime-read-passphrase prompt)))

119

120

(defun smime-add-passphrase-cache (key passphrase)

121

(set (intern key smime-passphrase-cache)

122

passphrase)

123

(run-at-time smime-passphrase-cache-expiry nil

124

#'smime-remove-passphrase-cache

125

key))

126

127

(defun smime-remove-passphrase-cache (key)

128

(let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))

129

(when passphrase

130

(fillarray passphrase ?_)

131

(unintern key smime-passphrase-cache))))

132

133

(defsubst smime-parse-attribute (string)

134

(delq nil (mapcar

135

(lambda (attr)

136

(if (string-match "=" attr)

137

(cons (intern (substring attr 0 (match-beginning 0)))

138

(substring attr (match-end 0)))

139

nil))

140

(split-string string "/"))))

141

142

(defsubst smime-query-signer (start end)

143

(smime-process-region start end smime-program (list "-qs"))

144

(with-current-buffer smime-output-buffer

145

(if (zerop (buffer-size)) nil

146

(goto-char (point-min))

147

(when (re-search-forward "^/" nil t)

148

(smime-parse-attribute

149

(buffer-substring (point) (progn (end-of-line)(point)))))

150

)))

151

152

(defsubst smime-x509-hash (cert-file)

153

(with-current-buffer (get-buffer-create smime-output-buffer)

154

(buffer-disable-undo)

155

(erase-buffer)

156

(apply #'call-process (car smime-x509-program) nil t nil

157

(append (cdr smime-x509-program)

158

(list "-hash" "-in" cert-file)))

159

(if (zerop (buffer-size)) nil

160

(buffer-substring (point-min) (1- (point-max))))))

161

162

(defsubst smime-x509-subject (cert-file)

163

(with-current-buffer (get-buffer-create smime-output-buffer)

164

(buffer-disable-undo)

165

(erase-buffer)

166

(apply #'call-process (car smime-x509-program) nil t nil

167

(append (cdr smime-x509-program)

168

(list "-subject" "-in" cert-file)))

169

(if (zerop (buffer-size)) nil

170

(goto-char (point-min))

171

(when (re-search-forward "^subject=" nil t)

172

(smime-parse-attribute

173

(buffer-substring (point)(progn (end-of-line)(point))))))))

174

175

(defsubst smime-find-certificate (attr)

176

(let ((files

177

(and (file-directory-p smime-certificate-directory)

178

(delq nil (mapcar (lambda (file)

179

(if (file-directory-p file) nil

180

file))

181

(directory-files

182

smime-certificate-directory

183

'full))))))

184

(catch 'found

185

(while files

186

(if (or (string-equal

187

(cdr (assq 'CN (smime-x509-subject (car files))))

188

(cdr (assq 'CN attr)))

189

(string-equal

190

(cdr (assq 'Email (smime-x509-subject (car files))))

191

(cdr (assq 'Email attr))))

192

(throw 'found (car files)))

193

(pop files)))))

194

195

(defun smime-process-region (start end program args)

196

(let* ((errors-file-name (make-temp-file "smime-errors"))

197

(args (append args (list (concat "2>" errors-file-name))))

198

(shell-file-name smime-shell-file-name)

199

(shell-command-switch smime-shell-command-switch)

200

(process-connection-type nil)

201

process status exit-status)

202

(with-current-buffer (get-buffer-create smime-output-buffer)

203

(buffer-disable-undo)

204

(erase-buffer))

205

(setq process

206

(apply #'binary-funcall #'start-process-shell-command

207

"*S/MIME*" smime-output-buffer

208

program args))

209

(set-process-sentinel process 'ignore)

210

(process-send-region process start end)

211

(process-send-eof process)

212

(while (eq 'run (process-status process))

213

(accept-process-output process 5))

214

(setq status (process-status process)

215

exit-status (process-exit-status process))

216

(delete-process process)

217

(with-current-buffer smime-output-buffer

218

(goto-char (point-min))

219

(while (re-search-forward "\r$" (point-max) t)

220

(replace-match ""))

221

222

(if (memq status '(stop signal))

223

(error "%s exited abnormally: '%s'" program exit-status))

224

(if (= 127 exit-status)

225

(error "%s could not be found" program))

226

227

(set-buffer (get-buffer-create smime-errors-buffer))

228

(buffer-disable-undo)

229

(erase-buffer)

230

(insert-file-contents errors-file-name)

231

(delete-file errors-file-name)

232

233

(if (and process (eq 'run (process-status process)))

234

(interrupt-process process))

235

)

236

))

237

238

;;; @ interface functions

239

;;;

240

241

;;;###autoload

242

(defun smime-encrypt-region (start end)

243

"Encrypt the current region between START and END."

244

(let* ((key-file

245

(or smime-private-key-file

246

(expand-file-name (read-file-name "Public key file: "))))

247

(args (list "-e" key-file)))

248

(smime-process-region start end smime-program args)

249

(smime-process-when-success

250

(goto-char (point-min))

251

(delete-region (point-min) (progn

252

(re-search-forward "^$" nil t)

253

(1+ (point)))))))

254

255

;;;###autoload

256

(defun smime-decrypt-region (start end)

257

"Decrypt the current region between START and END."

258

(let* ((key-file

259

(or smime-private-key-file

260

(expand-file-name (read-file-name "Private key file: "))))

261

(hash (smime-x509-hash key-file))

262

(passphrase (smime-read-passphrase

263

(format "S/MIME passphrase for %s: " hash)

264

hash))

265

(args (list "-d" key-file passphrase)))

266

(smime-process-region start end smime-program args)

267

(smime-process-when-success

268

(when smime-cache-passphrase

269

(smime-add-passphrase-cache hash passphrase)))))

270

271

;;;###autoload

272

(defun smime-sign-region (start end &optional cleartext)

273

"Make the signature from text between START and END.

274

If the optional 3rd argument CLEARTEXT is non-nil, it does not create

275

a detached signature."

276

(let* ((key-file

277

(or smime-private-key-file

278

(expand-file-name (read-file-name "Private key file: "))))

279

(hash (smime-x509-hash key-file))

280

(passphrase (smime-read-passphrase

281

(format "S/MIME passphrase for %s: " hash)

282

hash))

283

(args (list "-ds" key-file passphrase)))

284

(smime-process-region start end smime-program args)

285

(smime-process-when-success

286

(goto-char (point-min))

287

(delete-region (point-min) (progn

288

(re-search-forward "^$" nil t)

289

(1+ (point))))

290

(when smime-cache-passphrase

291

(smime-add-passphrase-cache hash passphrase)))))

292

293

;;;###autoload

294

(defun smime-verify-region (start end signature)

295

"Verify the current region between START and END.

296

If the optional 3rd argument SIGNATURE is non-nil, it is treated as

297

the detached signature of the current region."

298

(let* ((orig-file (make-temp-file "smime"))

299

(orig-mode (default-file-modes)))

300

(unwind-protect

301

(progn

302

(set-default-file-modes 448)

303

(binary-write-decoded-region start end orig-file))

304

(set-default-file-modes orig-mode))

305

(with-temp-buffer

306

(binary-insert-encoded-file signature)

307

(goto-char (point-max))

308

(binary-insert-encoded-file

309

(or (smime-find-certificate

310

(smime-query-signer (point-min)(point-max)))

311

(expand-file-name

312

(read-file-name "Certificate file: "))))

313

(smime-process-region (point-min)(point-max) smime-program

314

(list "-dv" orig-file)))

315

(smime-process-when-success nil)))

316

317

(provide 'smime)

318

319

;;; smime.el ends here