~ubuntu-branches/ubuntu/raring/mailcrypt/raring : revision 1

1

;; mc-gpg.el, GPG support for Mailcrypt

2

3

;; Patrick LoPresti <patl@lcs.mit.edu>

4

;; 1998 Brian Warner <warner@lothar.com>

5

6

;; $Id: mc-gpg.el,v 1.21 2002/09/25 00:12:55 warner Exp $

7

8

;;{{{ Licensing

9

;; This file is intended to be used with GNU Emacs.

10

11

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

12

;; it under the terms of the GNU General Public License as published by

13

;; the Free Software Foundation; either version 2, or (at your option)

14

;; any later version.

15

16

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

17

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

18

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

19

;; GNU 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

23

;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

24

;;}}}

25

(require 'mailcrypt)

26

27

; pieces to do:

28

29

; #key lookup?

30

; #mc-gpg-encrypt-region

31

; need to deal with untrusted keys, missing keys (offer to fetch), --throw

32

; #mc-gpg-decrypt-region [anything not clearsigned] (a,as,ae,ase)

33

; need to implement signature-key fetch, ponder --throw-keyid case

34

; keys without passphrases, sigs with bad algorithms (ignore sig? warn?)

35

; #mc-gpg-sign-region (clearsign/notclearsign)

36

; #mc-gpg-verify-region [clearsigned only] (ok/badsig/missingkey/corruptmsg)

37

; #mc-gpg-insert-public-key (comment, altkeyring)

38

; #mc-gpg-snarf-keys (one, multiple, old, corrupt)

39

; key fetching (is there a GPG key server yet?)

40

; clean up use of buffers, #kill off old tmp buffers

41

; in verify-region, print date of signature too

42

; ~maybe have bad-signature message print keyid/date? (no, sig is invalid,

43

; ~ anything other than its invalidity is misleading)

44

; make messages shorter (get it all to fit in echo area)

45

46

; enhancements I'd like to add

47

; trustdb status reporting during encryption/decryption: show the best trust

48

; path to the recipient/signer?

49

; completion on local id when signing (--list-secret-keys should know them)

50

; algorithm preferences, possibly by destination user

51

; (this is embedded in gpg)

52

; extra options, possibly by destination user. Maybe for pgp5.0/pgp2.6 compat?

53

; rfc2015 operation (MIME: application/pgp-signature, etc)

54

; signature dates are currently reported with just the date. Find a time

55

; formatting function and use the longtime in the VALIDSIG message.

56

57

; mc-gpg-alternate-keyring seems dubious.. have two options, public/private?

58

59

; using a shell introduces concerns about quoting and such. If the name of a

60

; key used as a recipient or as a mc-gpg-user-id (a key to sign with) has a

61

; double quote or ! or weird stuff, things could break.

62

63

; encrypting to a nontrusted key is problematic: when not in --batch mode,

64

; gpg warns the user and asks if they want to use the key anyway. In --batch

65

; mode, it fails, even if we give --yes. Worse yet, if we encrypt to multiple

66

; recipients, the untrusted ones get dropped withou flagging an error (stderr

67

; does get a message, but it doesn't indicate which keys had a problem)

68

69

(defvar mc-gpg-user-id (user-login-name)

70

"*GPG ID of your default identity.")

71

(defvar mc-gpg-path "gpg" "*The GPG executable.")

72

(defvar mc-gpg-display-snarf-output nil

73

"*If t, pop up the GPG output window when snarfing keys.")

74

(defvar mc-gpg-always-fetch 'never

75

"*If t, always fetch missing keys. If 'never, never fetch. If nil,

76

ask the user.")

77

(defvar mc-gpg-alternate-keyring nil

78

"*Public keyring to use instead of default.")

79

(defvar mc-gpg-comment

80

(format "Processed by Mailcrypt %s <http://mailcrypt.sourceforge.net/>"

81

mc-version)

82

"*Comment field to appear in ASCII armor output. If nil, let GPG use its

83

default.")

84

(defconst mc-gpg-msg-begin-line "^-----BEGIN PGP MESSAGE-----\r?$"

85

"Text for start of GPG message delimiter.")

86

(defconst mc-gpg-msg-end-line "^-----END PGP MESSAGE-----\r?$"

87

"Text for end of GPG message delimiter.")

88

(defconst mc-gpg-signed-begin-line "^-----BEGIN PGP SIGNED MESSAGE-----\r?$"

89

"Text for start of GPG signed messages.")

90

(defconst mc-gpg-signed-end-line "^-----END PGP SIGNATURE-----\r?$"

91

"Text for end of GPG signed messages.")

92

(defconst mc-gpg-key-begin-line "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"

93

"Text for start of GPG public key.")

94

(defconst mc-gpg-key-end-line "^-----END PGP PUBLIC KEY BLOCK-----\r?$"

95

"Text for end of GPG public key.")

96

(defvar mc-gpg-extra-args nil

97

"Extra arguments to pass to all invocations of gpg. Used during debugging to

98

set --homedir, to use special test keys instead of the developer's normal

99

keyring.")

100

(defvar mc-gpg-debug-buffer nil

101

"A buffer for debugging messages. If nil, no debugging messages are logged.

102

BEWARE! Sensitive data (including your passphrase) is put here. Set this with:

103

(setq mc-gpg-debug-buffer (get-buffer-create \"mc debug\"))")

104

105

;; we use with-current-buffer for clarity. emacs19 doesn't have it. This

106

;; code is cribbed from lazy-lock.el which does the same thing

107

(eval-when-compile

108

;; We use this for clarity and speed. Borrowed from a future Emacs.

109

(or (fboundp 'with-current-buffer)

110

(defmacro with-current-buffer (buffer &rest body)

111

"Execute the forms in BODY with BUFFER as the current buffer.

112

The value returned is the value of the last form in BODY."

113

(` (save-excursion (set-buffer (, buffer)) (,@ body)))))

114

)

115

116

(defun mc-gpg-debug-print (string)

117

(if (and (boundp 'mc-gpg-debug-buffer) mc-gpg-debug-buffer)

118

(print string mc-gpg-debug-buffer)))

119

120

;; the insert parser will return '(t) and insert the whole of stdout if

121

;; rc == 0, and will return '(nil rc stderr) if rc != 0

122

(defun mc-gpg-insert-parser (stdoutbuf stderrbuf statusbuf rc parserdata)

123

(mc-gpg-debug-print

124

(format "(mc-gpg-generic-parser stdoutbuf=%s stderrbuf=%s rc=%s"

125

stdoutbuf stderrbuf rc))

126

(if (= rc 0)

127

'(t (t))

128

(list nil nil rc (with-current-buffer stderrbuf (buffer-string))))

129

)

130

131

;; the null parser returns rc and never inserts anything

132

(defun mc-gpg-null-parser (stdoutbuf stderrbuf statusbuf rc parserdata)

133

(list nil rc))

134

135

; utility function (variant of mc-process-region):

136

; take region in current buffer, send as stdin to a process

137

; maybe send in a passphrase first

138

; three buffers of output are collected: stdout, stderr, and --status-fd

139

;

140

; parser is called with stdoutbuf as the current buffer as

141

; (parser stdoutbuf stderrbuf statusbuf rc parserdata)

142

; and is expected to return a list:

143

; '(REPLACEP RESULT)

144

;

145

; if REPLACEP is true, the original buffer's [beg..end] will be replaced by

146

; the stdout data buffer's contents (all of it). Otherwise the original buffer

147

; is left alone. RESULT (specifically (cdr parser-return-value)) is returned

148

; by mc-gpg-process-region.

149

150

(defun mc-gpg-process-region (beg end passwd program args parser bufferdummy

151

&optional parserdata)

152

(let ((obuf (current-buffer))

153

(process-connection-type nil)

154

(shell-file-name "/bin/sh") ;; ??? force? need sh (not tcsh) for "2>"

155

; other local vars

156

mybuf

157

stderr-tempfilename stderr-buf

158

status-tempfilename status-buf

159

proc rc status parser-result

160

)

161

(mc-gpg-debug-print (format

162

"(mc-gpg-process-region beg=%s end=%s passwd=%s program=%s args=%s parser=%s bufferdummy=%s)"

163

beg end passwd program args parser bufferdummy))

164

(setq stderr-tempfilename

165

(make-temp-name (expand-file-name "mailcrypt-gpg-stderr-"

166

mc-temp-directory)))

167

(setq status-tempfilename

168

(make-temp-name (expand-file-name "mailcrypt-gpg-status-"

169

mc-temp-directory)))

170

(unwind-protect

171

(progn

172

;; get output places ready

173

(setq mybuf (get-buffer-create " *mailcrypt stdout temp"))

174

(set-buffer mybuf)

175

(erase-buffer)

176

(set-buffer obuf)

177

(buffer-disable-undo mybuf)

178

179

(if passwd

180

(setq args (append '("--passphrase-fd" "0") args)))

181

(setq args (append (list (concat "2>" stderr-tempfilename)) args))

182

(setq args (append (list (concat "3>" status-tempfilename)) args))

183

(setq args (append '("--status-fd" "3") args))

184

185

(if mc-gpg-extra-args

186

(setq args (append mc-gpg-extra-args args)))

187

188

(mc-gpg-debug-print (format "prog is %s, args are %s"

189

program

190

(mapconcat '(lambda (x)

191

(format "'%s'" x))

192

args " ")))

193

194

(setq proc

195

(apply 'start-process-shell-command "*GPG*" mybuf

196

program args))

197

;; send in passwd if necessary

198

(if passwd

199

(progn

200

(process-send-string proc (concat passwd "\n"))

201

(or mc-passwd-timeout (mc-deactivate-passwd t))))

202

;; send in the region

203

(process-send-region proc beg end)

204

;; finish it off

205

(process-send-eof proc)

206

;; wait for it to finish

207

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

208

(accept-process-output proc 5))

209

;; remember result codes

210

(setq status (process-status proc))

211

(setq rc (process-exit-status proc))

212

(mc-gpg-debug-print (format "prog finished, rc=%s" rc))

213

214

;; Hack to force a status_notify() in Emacs 19.29

215

(delete-process proc)

216

217

;; remove the annoying "yes your process has finished" message

218

(set-buffer mybuf)

219

(goto-char (point-max))

220

(if (re-search-backward "\nProcess \\*GPG.*\n\\'" nil t)

221

(delete-region (match-beginning 0) (match-end 0)))

222

(goto-char (point-min))

223

;; CRNL -> NL

224

(while (search-forward "\r\n" nil t)

225

(replace-match "\n"))

226

227

;; ponder process death: signal, not just rc!=0

228

(if (or (eq 'stop status) (eq 'signal status))

229

;; process died

230

(error "%s exited abnormally: '%s'" program rc) ;;is rc a string?

231

)

232

233

(if (= 127 rc)

234

(error "%s could not be found" program) ;; at least on my system

235

)

236

237

;; fill stderr buf

238

(setq stderr-buf (get-buffer-create " *mailcrypt stderr temp"))

239

(buffer-disable-undo stderr-buf)

240

(set-buffer stderr-buf)

241

(erase-buffer)

242

(insert-file-contents stderr-tempfilename)

243

244

;; fill status buf

245

(setq status-buf (get-buffer-create " *mailcrypt status temp"))

246

(buffer-disable-undo status-buf)

247

(set-buffer status-buf)

248

(erase-buffer)

249

(insert-file-contents status-tempfilename)

250

251

;; feed the parser

252

(set-buffer mybuf)

253

(setq parser-result (funcall parser

254

mybuf stderr-buf status-buf

255

rc parserdata))

256

(mc-gpg-debug-print (format " parser returned %s" parser-result))

257

258

;; what did the parser tell us?

259

(if (car parser-result)

260

;; yes, replace region

261

(progn

262

(set-buffer obuf)

263

(delete-region beg end)

264

(goto-char beg)

265

(insert-buffer-substring mybuf)

266

))

267

268

;; return result

269

(cdr parser-result)

270

)

271

;; cleanup forms

272

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

273

;; it is still running. kill it.

274

(interrupt-process proc))

275

(set-buffer obuf)

276

(delete-file stderr-tempfilename)

277

(delete-file status-tempfilename)

278

;; kill off temporary buffers unless we're debugging

279

(if (or (not (boundp 'mc-gpg-debug-buffer))

280

(not mc-gpg-debug-buffer))

281

(progn

282

(if (get-buffer " *mailcrypt stdout temp")

283

(kill-buffer " *mailcrypt stdout temp"))

284

(if (get-buffer " *mailcrypt stderr temp")

285

(kill-buffer " *mailcrypt stderr temp"))

286

(if (get-buffer " *mailcrypt status temp")

287

(kill-buffer " *mailcrypt status temp"))

288

))

289

)))

290

291

292

; this lookup is used to turn key identifiers into names suitable for

293

; presentation to the user. When decrypting, the hex keyid to which the

294

; incoming message is encrypted is looked up to ask the user for a passphrase

295

; by name. When encrypting, the user's id (mc-gpg-user-id) is looked up to

296

; ask for a passphrase, and if mc-gpg-encrypt-to-me is true, the user's id

297

; is looked up to provide a full name to gpg. gpg is always given full names,

298

; because the hex keyids it provides might not work for both signing and

299

; encryption (split keys in gpg/pgp5)

300

;

301

;31:warner@zs2-pc4% gpg --list-secret-keys --with-colons --no-greeting

302

;/home/warner/.gnupg/secring.gpg

303

;-------------------------------

304

;sec::1024:17:1FE9CBFDC63B6750:1998-08-04:0:::Brian Warner (temporary GPG key) <warner@lothar.com>:

305

;ssb::1024:20:C68E8DE9F759FBDE:1998-08-04:0:::

306

;sec::768:17:16BD446D567E33CF:1998-08-04:0:::signature (sample signature key) <key@key>:

307

;sec::768:16:D514CB72B37D9AF4:1998-08-04:0:::crypt (crypt) <crypt@crypt>:

308

;sec::1024:17:4DBDD3258230A3E0:1998-08-04:0:::dummyy <d@d>:

309

;ssb::1024:20:549B0E6CBBBB43D1:1998-08-04:0:::

310

;

311

; we use the whole user id string (Brian..lothar.com>) as USER-ID, and the

312

; long keyid 1FE9CBFDC63B6750 for KEY-ID

313

314

(defvar mc-gpg-key-cache nil

315

"Association list mapping GPG IDs to canonical \"keys\". A \"key\"

316

is a pair (USER-ID . KEY-ID) which identifies the canonical IDs of the

317

GPG ID.")

318

319

(defun mc-gpg-lookup-key (str &optional type)

320

;; Look up the string STR in the user's secret key ring. Return a

321

;; pair of strings (USER-ID . KEY-ID) which uniquely identifies the

322

;; matching key, or nil if no key matches.

323

(let (args)

324

(if (string= str "***** CONVENTIONAL *****") nil

325

(let ((result (cdr-safe (assoc str mc-gpg-key-cache)))

326

(key-regexp

327

"^\$sec\\|pub\$:[^:]*:[^:]*:[^:]*:\$[^:]*\$:[^:]*:[^:]*:[^:]*:[^:]*:\$[^:]*\$:"

328

)

329

(obuf (current-buffer))

330

buffer)

331

(if (null result)

332

(unwind-protect

333

(progn

334

(setq buffer (generate-new-buffer " *mailcrypt temp"))

335

(setq args (list

336

"--with-colons"

337

"--no-greeting" "--batch"

338

"--list-secret-keys" str

339

))

340

(if mc-gpg-alternate-keyring

341

(setq args (append (list "--keyring"

342

mc-gpg-alternate-keyring)

343

args)))

344

(if mc-gpg-extra-args

345

(setq args (append mc-gpg-extra-args args)))

346

(mc-gpg-debug-print

347

(format "lookup: args are %s" args))

348

(let ((coding-system-for-read

349

(if (and (fboundp 'coding-system-p)

350

(coding-system-p 'utf-8))

351

'utf-8 nil)))

352

(apply 'call-process mc-gpg-path nil buffer nil args))

353

(set-buffer buffer)

354

(goto-char (point-min))

355

(if (re-search-forward key-regexp nil t)

356

(progn

357

(setq result

358

(cons (buffer-substring-no-properties

359

(match-beginning 3) (match-end 3))

360

(concat

361

"0x"

362

(buffer-substring-no-properties

363

(match-beginning 2) (match-end 2)))))

364

(setq mc-gpg-key-cache (cons (cons str result)

365

mc-gpg-key-cache)))))

366

;(if buffer (kill-buffer buffer))

367

(set-buffer obuf)))

368

(if (null result)

369

(error "No GPG secret key for %s" str))

370

result))))

371

372

;gpg: no info to calculate a trust probability

373

;gpg: no valid addressees

374

;gpg: [stdin]: encryption failed: No such user id

375

376

(defun mc-gpg-encrypt-region (recipients start end &optional id sign)

377

(let ((process-environment process-environment)

378

(buffer (get-buffer-create mc-buffer-name))

379

(obuf (current-buffer))

380

action msg args key passwd result gpg-id)

381

(mc-gpg-debug-print (format

382

"(mc-gpg-encrypt-region recipients=%s start=%s end=%s id=%s sign=%s)"

383

recipients start end id sign))

384

385

(setq args (list

386

"--batch" "--armor" "--textmode" "--always-trust"

387

(if recipients "--encrypt" "--store")

388

))

389

(setq action (if recipients "Encrypting" "Armoring"))

390

(setq msg (format "%s..." action)) ; May get overridden below

391

(if mc-gpg-comment

392

(setq args (append (list "--comment" (format "'%s'" mc-gpg-comment))

393

args)))

394

(if mc-gpg-alternate-keyring

395

(setq args (append (list "--keyring" mc-gpg-alternate-keyring) args)))

396

397

(if (and (not (eq mc-pgp-always-sign 'never))

398

(or mc-pgp-always-sign sign (y-or-n-p "Sign the message? ")))

399

(progn

400

(setq key (mc-gpg-lookup-key (or id mc-gpg-user-id) 'encrypt))

401

(setq passwd

402

(mc-activate-passwd

403

(cdr key)

404

(format "GPG passphrase for %s (%s): " (car key) (cdr key))))

405

(setq args

406

(append (list "--local-user" (cdr key)

407

"--sign"

408

)

409

args))

410

(setq msg (format "%s+signing as %s ..." action (car key)))

411

(if (not recipients)

412

;; the --store is last in args. remove it. remove --textmode too

413

(setq args (nreverse (cddr (nreverse args)))))

414

)

415

)

416

417

; if we're supposed to encrypt for the user too, we need their key

418

;; FIXME: we only need their public key, not the secret one. Some users

419

;; (the author included) keep their secret keys offline unless needed

420

;; (but the public ones are still available).. the --list-secret-keys

421

;; done by mc-gpg-lookup-key will fail in this situation. Change

422

;; mc-gpg-lookup-key to have a way to look for public keys too.

423

(if (and recipients mc-encrypt-for-me)

424

(setq recipients (cons (cdr (or key

425

(setq key (mc-gpg-lookup-key

426

mc-gpg-user-id 'encrypt)))

427

) recipients)))

428

429

; push(@args, map {qq<-r "$_">} @recipients) if @recipients; # roughly

430

(if recipients

431

(setq args (append (apply 'append

432

(mapcar '(lambda (x)

433

(list "--recipient"

434

(concat "\"" x "\"")))

435

recipients))

436

args)))

437

438

(message "%s" msg)

439

(setq result (mc-gpg-process-region start end passwd mc-gpg-path args

440

'mc-gpg-insert-parser buffer))

441

(if (not (car result))

442

(error "%s failed: %s" msg (nth 2 result)))

443

444

t

445

))

446

447

448

; GPG DECRYPT BEHAVIOR: gnupg-0.9.9 only

449

; (all status messages are prefixed by "[GNUPG:] "

450

451

; signed (not encrypted) by a known key [S.s1v]:

452

; rc == 0, stdout has message

453

; status:

454

; SIG_ID <sigid> <date> <longtime>

455

; GOODSIG <longkeyid> <username>

456

; VALIDSIG <keyfingerprint> <date> <longtime>

457

; TRUST_foo

458

459

; signed (not encrypted) by unknown key [S.s4]:

460

; rc == 2, stdout has message

461

; status:

462

; ERRSIG <longkeyid> <pubkeyalgo> <hashalgo> <sigclass> <longtime> <rc>

463

; NO_PUBKEY <longkeyid>

464

465

; encrypted to a private key we don't have [E.e3]:

466

; rc == 2,

467

; stderr: gpg: decryption failed: secret key not available

468

; status:

469

; ENC_TO <longkeyid> <keytype> <keylength==0>

470

; NO_SECKEY <longkeyid>

471

; DECRYPTION_FAILED

472

473

; encrypted to us, our key has no passphrase

474

; rc == 0?

475

; stderr: gpg: NOTE: secret key foo is NOT protected

476

; status:

477

; ENC_TO <longkeyid> <keytype> <keylen==0>

478

; GOOD_PASSPHRASE

479

; DECRYPTION_OKAY

480

481

; encrypted to us, but we didn't give a passphrase [E.e1r, no pw]:

482

; rc == 2

483

; stderr: gpg: fatal: Can't query password in batchmode

484

; status:

485

; ENC_TO <longkeyid> <keytype> <keylength==0>

486

; NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>

487

; MISSSING_PASSPHRASE

488

; BAD_PASSPHRASE <longkeyid>

489

; DECRYPTION_FAILED

490

; (N.B.: gpg cannot tell tell the difference between no passphrase and an

491

; empty passphrase.)

492

493

; encrypted to us *and someone else*, no passphrase [E.e3re1r, no pw]:

494

; rc == 2?

495

; stderr: gpg: fatal: Can't query password in batchmode

496

; status:

497

; ENC_TO <longkeyid1> <keytype> <keylength==0>

498

; NEED_PASSPHRASE <longkeyid1> <otherlongkeyid> <keytype> <keylen==0>

499

; MISSSING_PASSPHRASE

500

; BAD_PASSPHRASE <longkeyid1>

501

; ENC_TO <longkeyid2> .. ..

502

; NO_SECKEY <longkeyid2>

503

; DECRYPTION_FAILED

504

505

; encrypted to us, but we used the wrong passphrase [E.e1r, bad pw]:

506

; rc == 2

507

; stderr: gpg: public key decryption failed: [Bb]ad passphrase

508

; status:

509

; ENC_TO <longkeyid> <keytype> <keylength==0>

510

; NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>

511

; BAD_PASSPHRASE <longkeyid>

512

; DECRYPTION_FAILED

513

514

; encrypted to us, good passphrase [E.e1r, good pw]:

515

; rc == 0, stdout has message

516

; status:

517

; ENC_TO <longkeyid> <keytype> <keylength==0>

518

; NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>

519

; GOOD_PASSPHRASE

520

; DECRYPTION_OKAY

521

522

; encrypted to us, good passphrase, signed by trusted/untrusted party

523

; [ES.e1r.s1v, good ps]:

524

; rc == 0, stdout has message

525

; stderr: gpg: Signature made <date> using DSA key ID <pubkeyid>

526

; stderr: gpg: Good signature from "<keyname>"

527

; status:

528

; ENC_TO <longkeyid> <keytype> <keylength==0>

529

; NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>

530

; GOOD_PASSPHRASE

531

; SIG_ID <sigid> <date> <longtime>

532

; GOODSIG <longkeyid> <username>

533

; VALIDSIG <keyfingerprint> <date> <longtime>

534

; TRUST_(UNDEFINED|NEVER|MARGINAL|FULLY|ULTIMATE)

535

; DECRYPTION_OKAY

536

537

; encrypted to us, good passphrase, signed by unknown party [ES.e1r.s4]:

538

; rc == 2, stdout has message

539

; stderr: gpg: Signature made <date> using DSA key ID <pubkeyid>

540

; stderr: gpg: Can't check signature: [Pp]ublic key not found

541

; status:

542

; ENC_TO <longkeyid> <keytype> <keylength==0>

543

; NEED_PASSPHRASE <longkeyid> <otherlongkeyid> <keytype> <keylen==0>

544

; GOOD_PASSPHRASE

545

; ERRSIG <longkeyid> <pubkeyalgo> <hashalgo> <sigclass> <longtime> <rc>

546

; rc: 4 is unknown algorithm, 9 is missing public key

547

; NO_PUBKEY <longkeyid>

548

; DECRYPTION_OKAY

549

550

; symmetrically encrypted, we didn't give a passphrase

551

; rc == 2, stderr: gpg: fatal: Can't query password in batchmode

552

; status:

553

; NEED_PASSPHRASE_SYM <cipheralgo> <s2kmode> <s2khash>

554

; MISSING_PASSPHRASE

555

; DECRYPTION_FAILED

556

557

; symmetrically encrypted, we gave the wrong passphrase

558

; rc == 2, stderr: gpg: decryption failed: [Bb]ad key

559

; status:

560

; NEED_PASSPHRASE_SYM <cipheralgo> <s2kmode> <s2khash>

561

; DECRYPTION_FAILED

562

563

; symmetrically encrypted, good passphrase

564

; rc == 0, stdout: message

565

; status:

566

; NEED_PASSPHRASE_SYM <cipheralgo> <s2kmode> <s2khash>

567

; DECRYPTION_OKAY

568

569

; armored [A]:

570

; rc == 0, stdout: message

571

; no status

572

573

; corrupted armor

574

; rc == 2, stderr: gpg: CRC error; stuff - stuff

575

576

; ( to test: multiple recipients, keys without passphrases)

577

578

579

;; this parser's return convention:

580

;; '( (

581

;; replacep ; consumed by process-region: decrypt was successful

582

;;0 have-secret-key ; t: we are a recipient (TODO: stealth),

583

;; 'symmetric : need passphrase

584

;; 'signed : signed not encrypted

585

;; nil: not a recipient

586

;;1 passphrase-ok ; t was good, nil was bad, keyid: need pw for keyid

587

;;2 signature:

588

;; nil: no sig

589

;; keyid-hex : don't have signature key

590

;; '(keyid-string t trust date) : good signature on date with trust

591

;; '(keyid-string nil trust date) : bad signature on date with trust

592

;; )

593

;; )

594

; todo: stealth ("--throw-keyid")?

595

; when there is a signature that we can't check because of a bad algo

596

; then we pretend there wasn't a signature. extend the return convention

597

; to signal this case.

598

; when there is a signature that we can't check because we don't

599

; currently have a key, and if we successfully fetch that key in

600

; mc-gpg-decrypt-region, how do we restart the operation?

601

602

;; cases:

603

;; *not addressed to us (nil nil nil)

604

;; *just armored (same as good symmetric) ('symmetric t nil)

605

;; conventionally encrypted

606

;; *didn't give passphrase ('symmetric "***** CONVENTIONAL *****" nil)

607

;; did give passphrase

608

;; *bad passphrase ('symmetric nil nil)

609

;; *good passphrase ('symmetric t nil)

610

;; signed (not clearsigned), not encrypted

611

;; *don't have key ('signed t keyid)

612

;; do have key

613

;; *good sig ('signed t (t keyid-string trust date))

614

;; *bad sig ('signed t (nil keyid-string trust date))

615

;; encrypted to us:

616

;; *didn't give passphrase (t keyid nil)

617

;; gave passphrase:

618

;; *bad passphrase (t nil nil)

619

;; good passphrase

620

;; decrypted ok

621

;; *no signature (t t nil)

622

;; yes signature

623

;; *don't have key (offer to fetch) (t t keyid)

624

;; do have key

625

;; *good sig (t t (t keyid-string date trust))

626

;; *bad sig (t t (nil keyid-string date trust))

627

628

;; a subfunction to extract the signature info. Used in both decrypt-parser

629

;; and verify-parser. Call with statusbuf. Returns

630

;; '(sigtype sigid sigdate sigtrust)

631

632

(defun mc-gpg-sigstatus-parser ()

633

(let (sigtype sigid sigdate sigtrust)

634

635

;; sigtype: GOOD, BAD, ERR

636

;; sigid: who made the signature? (a name if possible, else hex keyid)

637

;; sigdate: date string of when the sig was made

638

(goto-char (point-min))

639

(if (re-search-forward "^\\[GNUPG:\\] +\$GOOD\\|BAD\\|ERR\$SIG\\b"

640

nil t)

641

(progn

642

(setq sigtype (match-string 1))

643

(goto-char (point-min))

644

(if (and (or (string= sigtype "GOOD") (string= sigtype "BAD"))

645

(re-search-forward

646

"^\\[GNUPG:\\] +\$GOOD\\|BAD\$SIG +\$\\S +\$ +\$.*\$$" nil t))

647

;; match-string 2 is the hex keyid of the signator.

648

;; #3 is the name

649

(setq sigid (match-string 3)))

650

651

;; for ERRSIG:

652

;; match-string #1 is the hex keyid, #2 is the algorithm ID

653

;; (17: DSA, 1,3: RSA, 20: Elgamal)

654

;; #3: hashalgo, #4: sigclass, #5: longtime, #6: rc

655

;; (rc==4 for unknown algo, 9 for missing public key)

656

;; we only set sigtype if:

657

;; (#1 is present), and

658

;; ((#6 is missing) or (#6 == 9))

659

;; the idea being to not fetch a key if we aren't going to be able

660

;; to use the algorithm it wants

661

(goto-char (point-min))

662

(if (and (string= sigtype "ERR")

663

(re-search-forward

664

"^\\[GNUPG:\\] +ERRSIG +\$\\S +\$" nil t))

665

(let (errsig-rc (sigid-temp (match-string 1)))

666

(goto-char (point-min))

667

(if (re-search-forward

668

"^\\[GNUPG:\\] +ERRSIG +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$" nil t)

669

(setq errsig-rc (match-string 6)))

670

(if (or

671

(not errsig-rc)

672

(string= errsig-rc "9"))

673

(setq sigid sigid-temp))

674

))

675

676

;; for GOODSIG:

677

;; VALIDSIG should be present, with <keyfingerprint> <date> <time>

678

(goto-char (point-min))

679

(if (and (string= sigtype "GOOD")

680

(re-search-forward

681

"^\\[GNUPG:\\] +SIG_ID +\$\\S +\$ +\$\\S +\$\\b"

682

nil t))

683

(setq sigdate (match-string 2))

684

;; in gpg >= 0.9.7, a third field is a longtime value (seconds

685

;; since epoch)

686

)

687

688

;; sigtrust: how trusted is the signing key?

689

(goto-char (point-min))

690

(if (re-search-forward "^\\[GNUPG:\\] +\$TRUST_\\S +\$$" nil t)

691

(setq sigtrust (match-string 1)))

692

))

693

694

(list sigtype sigid sigdate sigtrust))

695

)

696

697

698

; this parser's job is to find the decrypted data if any is available. The

699

; code in -decrypt-region will worry about reporting other status information

700

; like signatures. PARSERDATA is non-nil if a passphrase was given to GPG.

701

702

(defun mc-gpg-decrypt-parser (stdoutbuf stderrbuf statusbuf rc parserdata)

703

(let

704

(

705

decryptstatus ; DECRYPTION_(OKAY|FAILED)

706

no-seckey ; NO_SECKEY

707

keyid ; NEED_PASSPHRASE <keyid>

708

missing-passphrase ; MISSING_PASSPHRASE

709

symmetric ; NEED_PASSPHRASE_SYM

710

badpass ; BAD_PASSPHRASE

711

sigtype ; GOODSIG, BADSIG, ERRSIG

712

sigid ;; GOODSIG <keyid> (note: not SIG_ID!),

713

;;; or ERRSIG <keyid> if ERRSIG-rc is 9 for missing pubkey

714

sigdate ; VALIDSIG .. <date>

715

sigtrust ; TRUST_(UNDEFINED|NEVER|MARGINAL|FULLY|ULTIMATE)

716

)

717

;; this code is split into two pieces. The first scans statusbuf

718

;; (and stderr if absolutely necessary) for keywords, setting the

719

;; local variables to describe what happened during our decryption attempt.

720

;; We don't try too hard to interpret the results yet.

721

722

;; the second part (the big cond statement below) interprets those vars

723

;; to decide what to report to the caller

724

725

(set-buffer statusbuf)

726

727

;; decryptstatus: no decryption took place, one was ok, or one failed

728

(goto-char (point-min))

729

(if (re-search-forward

730

"^\\[GNUPG:\\] +DECRYPTION_\$OKAY\\|FAILED\$\\b"

731

nil t)

732

(setq decryptstatus (match-string 1)))

733

734

;; no-seckey: set if we saw a NO_SECKEY message.

735

(goto-char (point-min))

736

(if (re-search-forward

737

"^\\[GNUPG:\\] +NO_SECKEY\\b"

738

nil t)

739

(setq no-seckey t))

740

741

;; keyid: the message is encrypted to one of our private keys and we

742

;; need a passphrase from the user. which one?

743

(goto-char (point-min))

744

(if (re-search-forward "^\\[GNUPG:\\] +NEED_PASSPHRASE +\$\\S +\$"

745

nil t)

746

(setq keyid (concat "0x" (match-string 1))))

747

748

;; missing-passphrase: set if we saw MISSING_PASSPHRASE

749

(goto-char (point-min))

750

(if (re-search-forward "^\\[GNUPG:\\] +MISSING_PASSPHRASE\\b"

751

nil t)

752

(setq missing-passphrase t))

753

754

;; symmetric: Set if the message is symmetrically encrypted.

755

(goto-char (point-min))

756

(if (re-search-forward

757

"^\\[GNUPG:\\] +NEED_PASSPHRASE_SYM\\b"

758

nil t)

759

(setq symmetric t))

760

761

;; badpass: GPG did not get a good passphrase. Either we didn't give one

762

;; or we gave the wrong one.

763

(goto-char (point-min))

764

(if (re-search-forward "^\\[GNUPG:\\] +BAD_PASSPHRASE\\b"

765

nil t)

766

(setq badpass t))

767

768

(let ((sigstuff (mc-gpg-sigstatus-parser)))

769

(setq sigtype (nth 0 sigstuff))

770

(setq sigid (nth 1 sigstuff))

771

(setq sigdate (nth 2 sigstuff))

772

(setq sigtrust (nth 3 sigstuff))

773

)

774

775

;; begin second piece: stare at those variables and decide what happened.

776

;; refer to the "cases:" comment above for what we look for.

777

778

(mc-gpg-debug-print

779

(format

780

"decrypt-parser: decryptstatus=%s no-seckey=%s keyid=%s missing-passphrase=%s symmetric=%s badpass=%s sigtype=%s sigid=%s sigdate=%s sigtrust=%s rc=%s"

781

decryptstatus no-seckey keyid missing-passphrase symmetric badpass sigtype sigid sigdate sigtrust rc))

782

783

(cond

784

785

((and (not decryptstatus) (not (or keyid symmetric)))

786

;; either corrupt, armored-only, signed-only

787

;; or we're using an old gpg and no passphrase was requested:

788

;; either corrupt, armored-only, signed-only, or not for us.

789

(cond

790

(sigtype

791

;; signed-only. extract info

792

(cond

793

((string= sigtype "GOOD") ;; good signature

794

(list t 'signed t (list t sigid sigtrust sigdate)))

795

((string= sigtype "BAD") ;; bad signature

796

(list t 'signed t (list nil sigid sigtrust sigdate)))

797

((string= sigtype "ERR") ;; couldn't check: why?

798

(if sigid

799

;; didn't have the key, we can fetch it

800

(list t 'signed t sigid)

801

;; can't use it. pretend it wasn't signed.

802

(list t t t nil)))

803

(t ;; sigtype is bogus

804

(error "sigtype was bogus. Shouldn't happen."))

805

))

806

((not (= rc 0)) ;; corrupt

807

(error "The message was corrupt."))

808

(t ;; armored-only

809

(list t 'symmetric t nil))

810

))

811

812

((or

813

(string= decryptstatus "FAILED")

814

;; couldn't decrypt: not to us, need pw, bad pw

815

(and (not decryptstatus)

816

(or keyid symmetric)

817

(not (= rc 0))

818

(not (string= sigtype "ERR")))

819

;; or old gpg and we could have decrypted it (a passphrase was

820

;; requested), but the decrypt went bad (rc!=0 but not due to ERRSIG)

821

)

822

(cond

823

((and (not symmetric) (not keyid))

824

;; didn't ask for a passphrase, ergo it isn't for us

825

(list nil nil nil nil))

826

((or missing-passphrase (not parserdata))

827

;; we didn't give a passphrase, need pubkey or symmetric

828

(if symmetric

829

(list nil 'symmetric "***** CONVENTIONAL *****" nil)

830

(list nil t keyid nil)))

831

(symmetric ;; symmetric fails without a BAD_PASSPHRASE

832

(list nil 'symmetric nil nil))

833

((or badpass parserdata)

834

;; probably pubkey, we gave the wrong passphrase

835

(list nil t nil nil))

836

(t ;; shouldn't happen, error out

837

(error "decryption failed, but I don't know why. Shouldn't happen."))

838

))

839

840

((or

841

(string= decryptstatus "OKAY")

842

;; decrypted okay, check for signature

843

(and (not decryptstatus)

844

keyid

845

(not (= rc 0))

846

(string= sigtype "ERR"))

847

;; or old gpg and sigcheck went bad (rc!=0 due to ERRSIG)

848

(and (not decryptstatus)

849

keyid

850

(= rc 0))

851

;; or old gpg, passphrase was requested, no errors reported

852

)

853

(cond

854

(sigtype ;; there was a signature, extract the info (never sym here)

855

(cond

856

((string= sigtype "GOOD") ;; good signature

857

(list t t t (list t sigid sigtrust sigdate)))

858

((string= sigtype "BAD") ;; bad signature

859

(list t t t (list nil sigid sigtrust sigdate)))

860

((string= sigtype "ERR") ;; couldn't check: why?

861

(if sigid

862

;; didn't have the key. we can fetch it.

863

(list t t t sigid)

864

;; no keyid, or we can't use it. pretend there wasn't a sig.

865

(list t t t nil)))

866

(t ;; sigtype is bogus

867

(error "sigtype was bogus. Shouldn't happen."))

868

))

869

(t ;; there wasn't a signature

870

(if symmetric

871

(list t 'symmetric t nil)

872

(list t t t nil)))

873

))

874

875

(t ;; decryptstatus was bogus. error out.

876

(error "decryptstatus was bogus '%s'. Shouldn't happen." decryptstatus))

877

878

)

879

))

880

881

882

883

884

;; message about who made the signature. This is a bit wide.. the date can

885

;; easily run off the echo area. Consider replacing 'Good signature' with

886

;; 'good sig', but keep it consistent with everything else. This function is

887

;; used by both the decrypt section and the verify section.

888

;; todo: should the keyid be put in here? If the user reads the trustvalue,

889

;; and if they have a trust path, then they can trust the name.

890

(defun mc-gpg-format-sigline (goodp sigid sigtrust sigdate)

891

(if goodp

892

(format "Good signature from '%s' %s made %s"

893

sigid sigtrust sigdate)

894

(format "BAD SIGNATURE claiming to be from '%s'" sigid)

895

))

896

897

;; decrypt-region is first called without ID. This means we'll try to decrypt

898

;; without a passphrase, almost guaranteed to fail, but it will tell us which

899

;; key is necessary. We then call decrypt-region again, this time with ID

900

;; set. This second time will lookup ID and ask the user for the passphrase.

901

902

(defun mc-gpg-decrypt-region (start end &optional id)

903

;; returns a pair (SUCCEEDED . VERIFIED) where SUCCEEDED is t if

904

;; the decryption succeeded and verified is t if there was a valid signature

905

(let ((process-environment process-environment)

906

(buffer (get-buffer-create mc-buffer-name))

907

(obuf (current-buffer))

908

args key new-key passwd result gpg-id)

909

(mc-gpg-debug-print (format "(mc-gpg-decrypt-region start=%s end=%s id=%s)"

910

start end id))

911

(undo-boundary)

912

(if id

913

;; second time through, now we know who the message is for.

914

;; id is either a hex keyid of the (first?) secret key that is in

915

;; the message's recipient list, or "**..CONVENTIONAL.."

916

(progn

917

(setq key (mc-gpg-lookup-key id 'encrypt))

918

;; key is nil if CONVENTIONAL, (string . hexid) otherwise

919

(setq passwd

920

(if key

921

(mc-activate-passwd (cdr key)

922

(format

923

"GPG passphrase for %s (%s): "

924

(car key) (cdr key)))

925

(mc-activate-passwd

926

id "GPG passphrase for conventional decryption: ")))

927

(if (string= passwd "")

928

(progn

929

(mc-deactivate-passwd t)

930

(error "Empty passphrases are bad, mmkay?")))

931

;; in particular, they cause an infinite loop. If the key doesn't

932

;; have a passphrase, the decryption should have worked the first

933

;; time around.

934

))

935

(setq args '("--batch"))

936

(if mc-gpg-alternate-keyring

937

(setq args (append args (list "--keyring" mc-gpg-alternate-keyring))))

938

(setq args (append args '("--decrypt"))) ; this wants to be last

939

(message "Decrypting...")

940

;; pass ID as the parserdata. This will be non-nil if a passphrase was

941

;; given (i.e. 2nd pass), which affects decrypt status parsing

942

(setq result

943

(mc-gpg-process-region

944

start end passwd mc-gpg-path args 'mc-gpg-decrypt-parser buffer id))

945

;(message "Decrypting... Done.")

946

;; result: '(HAVE-SECRET-KEY PASSPHRASE-OK SIG)

947

;; SIG: nil, sigkeyid, or '(KEYID GOODP TRUSTLEVEL DATESTRING)

948

(cond

949

((not (nth 0 result)) ;; we were not a recipient

950

(error "This message is not addressed to you"))

951

((not (nth 1 result)) ;; passphrase-ok is nil: bad passphrase

952

(mc-deactivate-passwd t)

953

(error "That passphrase was wrong"))

954

((not (equal (nth 1 result) t)) ;; passphrase-ok is keyid: need passphrase

955

;; get passphrase for (nth 1 result), try again

956

(mc-gpg-decrypt-region start end (nth 1 result))

957

)

958

;; passphrase was ok, were able to decrypt

959

((nth 2 result) ;; there was a signature

960

(let ((sig (nth 2 result)))

961

(cond

962

((atom sig) ;; don't have the signature key

963

(progn

964

;; offer to fetch the key, then what? run again? must we undo 1st?

965

(mc-message-sigstatus

966

(format "cannot check signature from keyid %s" sig))

967

(if (and (not (eq mc-gpg-always-fetch 'never))

968

(or mc-gpg-always-fetch

969

(y-or-n-p

970

(format "Key %s not found; attempt to fetch? " sig)))

971

(mc-gpg-fetch-key (cons nil sig)))

972

(progn

973

(undo-start)

974

(undo-more 1)

975

(mc-gpg-decrypt-region start end id))

976

'(t . nil))

977

))

978

((nth 0 sig) ;; good signature

979

(progn

980

(mc-message-sigstatus (mc-gpg-format-sigline

981

t (nth 1 sig) (nth 2 sig) (nth 3 sig)))

982

'(t . t)

983

))

984

(t ;; bad signature

985

(progn

986

(mc-message-sigstatus (mc-gpg-format-sigline

987

nil (nth 1 sig) (nth 2 sig) (nth 3 sig))

988

t ; get their attention

989

)

990

'(t . nil)

991

))

992

)))

993

(t ;; no signature

994

(message "Decrypting... Done.")

995

'(t . nil)

996

))

997

))

998

999

(defun mc-gpg-sign-region (start end &optional id unclear)

1000

(let ((process-environment process-environment)

1001

(buffer (get-buffer-create mc-buffer-name))

1002

passwd args key result)

1003

(setq key (mc-gpg-lookup-key (or id mc-gpg-user-id) 'sign))

1004

(setq passwd

1005

(mc-activate-passwd

1006

(cdr key)

1007

(format "GPG passphrase for %s (%s): " (car key) (cdr key))))

1008

(setq args

1009

(list

1010

"--batch" "--armor"

1011

"--local-user" (cdr key)

1012

(if unclear "--sign" "--clearsign")

1013

))

1014

(if mc-gpg-comment

1015

(setq args (append (list "--comment" (format "'%s'" mc-gpg-comment))

1016

args)))

1017

(if mc-gpg-extra-args

1018

(setq args (append mc-gpg-extra-args args)))

1019

(message "Signing as %s ..." (car key))

1020

(setq result (mc-gpg-process-region start end passwd mc-gpg-path args

1021

'mc-gpg-insert-parser buffer))

1022

(if (car result)

1023

(message "Signing as %s ... Done." (car key))

1024

(progn

1025

(mc-deactivate-passwd t)

1026

(error "Signature failed: %s" (nth 2 result))

1027

))

1028

(car result)

1029

))

1030

1031

1032

; GPG VERIFY BEHAVIOR: gnupg-0.9.9 only

1033

; (all status messages are prefixed by "[GNUPG:] "

1034

; (filenames in [] are my parts of my testsuite)

1035

1036

; corrupted sig (armor is corrupt) [CS.s1bad]:

1037

; rc == 2

1038

; stderr: gpg: CRC error; stuff - stuff

1039

; gpg: packet(1) with unknown version

1040

1041

; GOOD sig from a known key [CS.s1v,CS.s2v,CS.s3v]

1042

; rc == 0

1043

; status:

1044

; SIG_ID <sigid> <date> <longtime>

1045

; GOODSIG <longkeyid> <username>

1046

; VALIDSIG <keyfingerprint> <date> <longtime>

1047

; TRUST_(UNDEFINED|NEVER|MARGINAL|FULLY|ULTIMATE)

1048

1049

; BAD sig from a known key [CS.s1f]:

1050

; rc == 1

1051

; status: BADSIG <longkeyid> <username>

1052

1053

; unknown key [CS.s4]:

1054

; rc == 2

1055

; status:

1056

; ERRSIG <longkeyid> <pubkeyalgo> <hashalgo> <sigclass> <longtime> <rc==9>

1057

; NO_PUBKEY <longkeyid>

1058

1059

;; so no status messages mean armor corruption

1060

1061

;; return convention for mc-gpg-verify-parser:

1062

;; (same as sig section of decrypt parser)

1063

;; sigid : signed by an unknown key, need this key to verify

1064

;; '(t sigid sigtrust sigdate): good sig from sigid

1065

;; '(nil sigid sigtrust sigdate): forged sig "from" sigid

1066

;; (actual return includes a leading nil because the verify-parser should

1067

;; never replace the region with stdout)

1068

1069

(defun mc-gpg-verify-parser (stdoutbuf stderrbuf statusbuf rc parserdata)

1070

(let (sigtype sigid sigdate sigtrust)

1071

;; parse FOOSIG with the same code as decrypt-parser

1072

(set-buffer statusbuf)

1073

1074

(let ((sigstuff (mc-gpg-sigstatus-parser)))

1075

(setq sigtype (nth 0 sigstuff))

1076

(setq sigid (nth 1 sigstuff))

1077

(setq sigdate (nth 2 sigstuff))

1078

(setq sigtrust (nth 3 sigstuff))

1079

)

1080

1081

(mc-gpg-debug-print

1082

(format

1083

"decrypt-parser: sigtype=%s sigid=%s sigdate=%s sigtrust=%s"

1084

sigtype sigid sigdate sigtrust))

1085

1086

(if (and (not (= rc 0))

1087

(not sigtype))

1088

(error "The message was corrupt."))

1089

1090

(cond

1091

((string= sigtype "ERR")

1092

(list nil sigid))

1093

((string= sigtype "GOOD")

1094

(list nil (list t sigid sigtrust sigdate))) ;; good sig

1095

(t

1096

(list nil (list nil sigid sigtrust sigdate))))

1097

))

1098

1099

1100

; check a signature, print a message about its validity. Returns t if the

1101

; sig was valid, nil otherwise

1102

1103

(defun mc-gpg-verify-region (start end &optional no-fetch)

1104

(let ((buffer (get-buffer-create mc-buffer-name))

1105

(obuf (current-buffer))

1106

args result)

1107

(setq args '("--batch" "--verify"))

1108

(if mc-gpg-alternate-keyring

1109

(setq args (append "--keyring" mc-gpg-alternate-keyring args)))

1110

(message "Verifying...")

1111

(setq result (mc-gpg-process-region

1112

start end nil mc-gpg-path args 'mc-gpg-verify-parser buffer))

1113

(mc-gpg-debug-print (format "process-region returned %s" result))

1114

(setq result (car result))

1115

1116

(cond

1117

1118

((atom result)

1119

;; need key

1120

(if (and

1121

(not no-fetch)

1122

(not (eq mc-gpg-always-fetch 'never))

1123

(or mc-gpg-always-fetch

1124

(y-or-n-p

1125

(format "Key %s not found; attempt to fetch? " result)))

1126

(mc-gpg-fetch-key (cons nil result))

1127

(set-buffer obuf))

1128

(mc-gpg-verify-region start end t)

1129

(error "Can't check signature: Public key %s not found" result)))

1130

1131

((nth 0 result)

1132

;; good sig

1133

(progn

1134

(message (mc-gpg-format-sigline

1135

t (nth 1 result) (nth 2 result) (nth 3 result)))

1136

t))

1137

1138

(t

1139

;; bad sig

1140

(progn

1141

(ding)

1142

(message (mc-gpg-format-sigline

1143

nil (nth 1 result) (nth 2 result) (nth 3 result)))

1144

nil))

1145

)

1146

))

1147

1148

(defun mc-gpg-insert-public-key (&optional id)

1149

(let ((buffer (get-buffer-create mc-buffer-name))

1150

args result)

1151

(setq id (or id mc-gpg-user-id))

1152

(setq args (list "--export" "--armor" "--batch" (concat "\"" id "\"")))

1153

(if mc-gpg-comment

1154

(setq args (append (list "--comment" (format "'%s'" mc-gpg-comment))

1155

args)))

1156

(if mc-gpg-alternate-keyring

1157

(setq args (append (list "--keyring" mc-gpg-alternate-keyring) args)))

1158

1159

(setq result (mc-gpg-process-region (point) (point) nil mc-gpg-path

1160

args 'mc-gpg-insert-parser buffer))

1161

(if (car result)

1162

(message (format "Key for user ID: %s" id))

1163

(message "failed: %s" (nth 2 result)))

1164

(car result)

1165

))

1166

1167

;; GPG IMPORT BEHAVIOR: gnupg-0.9.9 only

1168

1169

;; status:

1170

;; IMPORT_RES (12 fields)

1171

;; 1 <count> : number of keys seen

1172

;; 2 <no_user_id> : the number of keys without valid userids, including

1173

;; keys that weren't self-signed

1174

;; 3 <imported> : new public keys

1175

;; 4 <imported_rsa> : new RSA public keys (included in <imported>)

1176

;; 5 <unchanged> : old public keys

1177

;; 6 <n_uids>

1178

;; 7 <n_subk>

1179

;; 8 <n_sigs>

1180

;; 9 <n_revoc>

1181

;; 10 <sec_read> : number of secret keys seen

1182

;; 11 <sec_imported> : new secret keys

1183

;; 12 <sec_dups> : old secret keys

1184

1185

;; the first three are for public keys, the last three are for secret keys.

1186

;; add them together, I guess. It's unlikely that anyone will be importing

1187

;; armored secret keys via email, but if they do it will be reported as if

1188

;; it were a public key.

1189

1190

;; return convention:

1191

;; error with stderr if rc != 0

1192

;; '(count bad new old changed secretp)

1193

1194

(defun mc-gpg-snarf-parser (stdoutbuf stderrbuf statusbuf rc parserdata)

1195

(if (eq rc 0)

1196

(let (count bad new old changed secretp)

1197

(set-buffer statusbuf)

1198

(goto-char (point-min))

1199

(if (re-search-forward

1200

"^\\[GNUPG:\\] +IMPORT_RES +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$ +\$\\S +\$"

1201

nil t)

1202

(progn

1203

(setq count (string-to-number (match-string 1)))

1204

(setq bad (string-to-number (match-string 2)))

1205

(setq new (+ (string-to-number (match-string 3))

1206

(string-to-number (match-string 11))))

1207

(setq old (+ (string-to-number (match-string 5))

1208

(string-to-number (match-string 12))))

1209

(setq changed (- count bad new old))

1210

(setq secretp (not (string= (match-string 10) "0")))

1211

(list nil count bad new old changed secretp))

1212

(error "No key import status: your GnuPG is too old."))

1213

)

1214

(error (with-current-buffer stderrbuf (buffer-string))))

1215

)

1216

1217

(defun mc-gpg-snarf-keys (start end)

1218

;; Returns number of keys found.

1219

(let ((buffer (get-buffer-create mc-buffer-name))

1220

results args msg)

1221

(setq args '("--import" "--batch"))

1222

(if mc-gpg-alternate-keyring

1223

(setq args (append args (list "--keyring" mc-gpg-alternate-keyring))))

1224

(message "Snarfing...")

1225

(setq results (mc-gpg-process-region start end nil mc-gpg-path args

1226

'mc-gpg-snarf-parser buffer))

1227

;; don't have to update trustdb: gpg does it automatically (although it

1228

;; might take a few seconds if a lot of keys or signatures have been

1229

;; added).

1230

1231

;; Is there any point to displaying this message? mc-snarf-keys will

1232

;; display a simple "%d new keys found" message right after we return.

1233

;; Well, print it anyway, if the user looks in the *Messages* buffer

1234

;; they'll see more.

1235

(setq msg (format "%d keys seen" (nth 0 results)))

1236

(if (not (zerop (nth 1 results)))

1237

(setq msg (concat msg (format ", %d bad" (nth 1 results)))))

1238

(if (not (zerop (nth 2 results)))

1239

(setq msg (concat msg (format ", %d new" (nth 2 results)))))

1240

(if (not (zerop (nth 3 results)))

1241

(setq msg (concat msg (format ", %d old" (nth 3 results)))))

1242

(if (not (zerop (nth 4 results)))

1243

(setq msg (concat msg (format ", %d changed" (nth 4 results)))))

1244

(if (nth 5 results)

1245

(setq msg (concat msg ", SECRET KEYS IMPORTED")))

1246

1247

(message msg)

1248

(nth 2 results)

1249

))

1250

1251

(defun mc-scheme-gpg ()

1252

(list

1253

(cons 'encryption-func 'mc-gpg-encrypt-region)

1254

(cons 'decryption-func 'mc-gpg-decrypt-region)

1255

(cons 'signing-func 'mc-gpg-sign-region)

1256

(cons 'verification-func 'mc-gpg-verify-region)

1257

(cons 'key-insertion-func 'mc-gpg-insert-public-key)

1258

(cons 'snarf-func 'mc-gpg-snarf-keys)

1259

(cons 'msg-begin-line mc-gpg-msg-begin-line)

1260

(cons 'msg-end-line mc-gpg-msg-end-line)

1261

(cons 'signed-begin-line mc-gpg-signed-begin-line)

1262

(cons 'signed-end-line mc-gpg-signed-end-line)

1263

(cons 'key-begin-line mc-gpg-key-begin-line)

1264

(cons 'key-end-line mc-gpg-key-end-line)

1265

(cons 'user-id mc-gpg-user-id)))

1266

1267

;;{{{ Key fetching

1268

1269

(defvar mc-gpg-always-fetch 'never

1270

"*If t, always attempt to fetch missing keys, or never fetch if

1271

'never.")

1272

1273

(defun mc-gpg-fetch-key (&optional id)

1274

"Attempt to fetch a key for addition to GPG keyring. Interactively,

1275

prompt for string matching key to fetch.

1276

1277

This function is not yet implemented. The GPG documentation suggests a simple

1278

keyserver protocol, but as far as I know it has not yet been implemented

1279

anywhere."

1280

1281

(error "Key fetching not yet implemented"))

1282

1283

;;}}}