1;;; binhex.el --- elisp native binhex decode 2 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> 7;; Keywords: binhex news 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs 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;; GNU Emacs 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 the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;;; Code: 29 30(autoload 'executable-find "executable") 31 32(eval-when-compile (require 'cl)) 33 34(eval-and-compile 35 (defalias 'binhex-char-int 36 (if (fboundp 'char-int) 37 'char-int 38 'identity))) 39 40(defcustom binhex-decoder-program "hexbin" 41 "*Non-nil value should be a string that names a binhex decoder. 42The program should expect to read binhex data on its standard 43input and write the converted data to its standard output." 44 :type 'string 45 :group 'gnus-extract) 46 47(defcustom binhex-decoder-switches '("-d") 48 "*List of command line flags passed to the command `binhex-decoder-program'." 49 :group 'gnus-extract 50 :type '(repeat string)) 51 52(defcustom binhex-use-external 53 (executable-find binhex-decoder-program) 54 "*Use external binhex program." 55 :version "22.1" 56 :group 'gnus-extract 57 :type 'boolean) 58 59(defconst binhex-alphabet-decoding-alist 60 '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) 61 ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11) 62 ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17) 63 ( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23) 64 ( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29) 65 ( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35) 66 ( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41) 67 ( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47) 68 ( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53) 69 ( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59) 70 ( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63))) 71 72(defun binhex-char-map (char) 73 (cdr (assq char binhex-alphabet-decoding-alist))) 74 75;;;###autoload 76(defconst binhex-begin-line 77 "^:...............................................................$") 78(defconst binhex-body-line 79 "^[^:]...............................................................$") 80(defconst binhex-end-line ":$") 81 82(defvar binhex-temporary-file-directory 83 (cond ((fboundp 'temp-directory) (temp-directory)) 84 ((boundp 'temporary-file-directory) temporary-file-directory) 85 ("/tmp/"))) 86 87(eval-and-compile 88 (defalias 'binhex-insert-char 89 (if (featurep 'xemacs) 90 'insert-char 91 (lambda (char &optional count ignored buffer) 92 "Insert COUNT copies of CHARACTER into BUFFER." 93 (if (or (null buffer) (eq buffer (current-buffer))) 94 (insert-char char count) 95 (with-current-buffer buffer 96 (insert-char char count))))))) 97 98(defvar binhex-crc-table 99 [0 4129 8258 12387 16516 20645 24774 28903 100 33032 37161 41290 45419 49548 53677 57806 61935 101 4657 528 12915 8786 21173 17044 29431 25302 102 37689 33560 45947 41818 54205 50076 62463 58334 103 9314 13379 1056 5121 25830 29895 17572 21637 104 42346 46411 34088 38153 58862 62927 50604 54669 105 13907 9842 5649 1584 30423 26358 22165 18100 106 46939 42874 38681 34616 63455 59390 55197 51132 107 18628 22757 26758 30887 2112 6241 10242 14371 108 51660 55789 59790 63919 35144 39273 43274 47403 109 23285 19156 31415 27286 6769 2640 14899 10770 110 56317 52188 64447 60318 39801 35672 47931 43802 111 27814 31879 19684 23749 11298 15363 3168 7233 112 60846 64911 52716 56781 44330 48395 36200 40265 113 32407 28342 24277 20212 15891 11826 7761 3696 114 65439 61374 57309 53244 48923 44858 40793 36728 115 37256 33193 45514 41451 53516 49453 61774 57711 116 4224 161 12482 8419 20484 16421 28742 24679 117 33721 37784 41979 46042 49981 54044 58239 62302 118 689 4752 8947 13010 16949 21012 25207 29270 119 46570 42443 38312 34185 62830 58703 54572 50445 120 13538 9411 5280 1153 29798 25671 21540 17413 121 42971 47098 34713 38840 59231 63358 50973 55100 122 9939 14066 1681 5808 26199 30326 17941 22068 123 55628 51565 63758 59695 39368 35305 47498 43435 124 22596 18533 30726 26663 6336 2273 14466 10403 125 52093 56156 60223 64286 35833 39896 43963 48026 126 19061 23124 27191 31254 2801 6864 10931 14994 127 64814 60687 56684 52557 48554 44427 40424 36297 128 31782 27655 23652 19525 15522 11395 7392 3265 129 61215 65342 53085 57212 44955 49082 36825 40952 130 28183 32310 20053 24180 11923 16050 3793 7920]) 131 132(defun binhex-update-crc (crc char &optional count) 133 (if (null count) (setq count 1)) 134 (while (> count 0) 135 (setq crc (logxor (logand (lsh crc 8) 65280) 136 (aref binhex-crc-table 137 (logxor (logand (lsh crc -8) 255) 138 char))) 139 count (1- count))) 140 crc) 141 142(defun binhex-verify-crc (buffer start end) 143 (with-current-buffer buffer 144 (let ((pos start) (crc 0) (last (- end 2))) 145 (while (< pos last) 146 (setq crc (binhex-update-crc crc (char-after pos)) 147 pos (1+ pos))) 148 (if (= crc (binhex-string-big-endian (buffer-substring last end))) 149 nil 150 (error "CRC error"))))) 151 152(defun binhex-string-big-endian (string) 153 (let ((ret 0) (i 0) (len (length string))) 154 (while (< i len) 155 (setq ret (+ (lsh ret 8) (binhex-char-int (aref string i))) 156 i (1+ i))) 157 ret)) 158 159(defun binhex-string-little-endian (string) 160 (let ((ret 0) (i 0) (shift 0) (len (length string))) 161 (while (< i len) 162 (setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift)) 163 i (1+ i) 164 shift (+ shift 8))) 165 ret)) 166 167(defun binhex-header (buffer) 168 (with-current-buffer buffer 169 (let ((pos (point-min)) len) 170 (vector 171 (prog1 172 (setq len (binhex-char-int (char-after pos))) 173 (setq pos (1+ pos))) 174 (buffer-substring pos (setq pos (+ pos len))) 175 (prog1 176 (setq len (binhex-char-int (char-after pos))) 177 (setq pos (1+ pos))) 178 (buffer-substring pos (setq pos (+ pos 4))) 179 (buffer-substring pos (setq pos (+ pos 4))) 180 (binhex-string-big-endian 181 (buffer-substring pos (setq pos (+ pos 2)))) 182 (binhex-string-big-endian 183 (buffer-substring pos (setq pos (+ pos 4)))) 184 (binhex-string-big-endian 185 (buffer-substring pos (setq pos (+ pos 4)))))))) 186 187(defvar binhex-last-char) 188(defvar binhex-repeat) 189 190(defun binhex-push-char (char &optional count ignored buffer) 191 (cond 192 (binhex-repeat 193 (if (eq char 0) 194 (binhex-insert-char (setq binhex-last-char 144) 1 195 ignored buffer) 196 (binhex-insert-char binhex-last-char (- char 1) 197 ignored buffer) 198 (setq binhex-last-char nil)) 199 (setq binhex-repeat nil)) 200 ((= char 144) 201 (setq binhex-repeat t)) 202 (t 203 (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) 204 205;;;###autoload 206(defun binhex-decode-region-internal (start end &optional header-only) 207 "Binhex decode region between START and END without using an external program. 208If HEADER-ONLY is non-nil only decode header and return filename." 209 (interactive "r") 210 (let ((work-buffer nil) 211 (counter 0) 212 (bits 0) (tmp t) 213 (lim 0) inputpos 214 (non-data-chars " \t\n\r:") 215 file-name-length data-fork-start 216 header 217 binhex-last-char binhex-repeat) 218 (unwind-protect 219 (save-excursion 220 (goto-char start) 221 (when (re-search-forward binhex-begin-line end t) 222 (let (default-enable-multibyte-characters) 223 (setq work-buffer (generate-new-buffer " *binhex-work*"))) 224 (beginning-of-line) 225 (setq bits 0 counter 0) 226 (while tmp 227 (skip-chars-forward non-data-chars end) 228 (setq inputpos (point)) 229 (end-of-line) 230 (setq lim (point)) 231 (while (and (< inputpos lim) 232 (setq tmp (binhex-char-map (char-after inputpos)))) 233 (setq bits (+ bits tmp) 234 counter (1+ counter) 235 inputpos (1+ inputpos)) 236 (cond ((= counter 4) 237 (binhex-push-char (lsh bits -16) 1 nil work-buffer) 238 (binhex-push-char (logand (lsh bits -8) 255) 1 nil 239 work-buffer) 240 (binhex-push-char (logand bits 255) 1 nil 241 work-buffer) 242 (setq bits 0 counter 0)) 243 (t (setq bits (lsh bits 6))))) 244 (if (null file-name-length) 245 (with-current-buffer work-buffer 246 (setq file-name-length (char-after (point-min)) 247 data-fork-start (+ (point-min) 248 file-name-length 22)))) 249 (if (and (null header) 250 (with-current-buffer work-buffer 251 (>= (buffer-size) data-fork-start))) 252 (progn 253 (binhex-verify-crc work-buffer 254 (point-min) data-fork-start) 255 (setq header (binhex-header work-buffer)) 256 (if header-only (setq tmp nil counter 0)))) 257 (setq tmp (and tmp (not (eq inputpos end))))) 258 (cond 259 ((= counter 3) 260 (binhex-push-char (logand (lsh bits -16) 255) 1 nil 261 work-buffer) 262 (binhex-push-char (logand (lsh bits -8) 255) 1 nil 263 work-buffer)) 264 ((= counter 2) 265 (binhex-push-char (logand (lsh bits -10) 255) 1 nil 266 work-buffer)))) 267 (if header-only nil 268 (binhex-verify-crc work-buffer 269 data-fork-start 270 (+ data-fork-start (aref header 6) 2)) 271 (or (markerp end) (setq end (set-marker (make-marker) end))) 272 (goto-char start) 273 (insert-buffer-substring work-buffer 274 data-fork-start (+ data-fork-start 275 (aref header 6))) 276 (delete-region (point) end))) 277 (and work-buffer (kill-buffer work-buffer))) 278 (if header (aref header 1)))) 279 280;;;###autoload 281(defun binhex-decode-region-external (start end) 282 "Binhex decode region between START and END using external decoder." 283 (interactive "r") 284 (let ((cbuf (current-buffer)) firstline work-buffer status 285 (file-name (expand-file-name 286 (concat (binhex-decode-region-internal start end t) 287 ".data") 288 binhex-temporary-file-directory))) 289 (save-excursion 290 (goto-char start) 291 (when (re-search-forward binhex-begin-line nil t) 292 (let ((cdir default-directory) default-process-coding-system) 293 (unwind-protect 294 (progn 295 (set-buffer (setq work-buffer 296 (generate-new-buffer " *binhex-work*"))) 297 (buffer-disable-undo work-buffer) 298 (insert-buffer-substring cbuf firstline end) 299 (cd binhex-temporary-file-directory) 300 (apply 'call-process-region 301 (point-min) 302 (point-max) 303 binhex-decoder-program 304 nil 305 nil 306 nil 307 binhex-decoder-switches)) 308 (cd cdir) (set-buffer cbuf))) 309 (if (and file-name (file-exists-p file-name)) 310 (progn 311 (goto-char start) 312 (delete-region start end) 313 (let (format-alist) 314 (insert-file-contents-literally file-name))) 315 (error "Can not binhex"))) 316 (and work-buffer (kill-buffer work-buffer)) 317 (ignore-errors 318 (if file-name (delete-file file-name)))))) 319 320;;;###autoload 321(defun binhex-decode-region (start end) 322 "Binhex decode region between START and END." 323 (interactive "r") 324 (if binhex-use-external 325 (binhex-decode-region-external start end) 326 (binhex-decode-region-internal start end))) 327 328(provide 'binhex) 329 330;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8 331;;; binhex.el ends here 332