diff options
| -rw-r--r-- | lisp/arc-mode.el | 139 |
1 files changed, 90 insertions, 49 deletions
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 95b47915cd..583b8c2542 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -77,6 +77,12 @@ ;; ;; LZH A series of (header,file). Headers are checksummed. No ;; interaction among members. +;; Headers come in three flavours called level 0, 1 and 2 headers. +;; Level 2 header is free of DOS specific restrictions and most +;; prevalently used. Also level 1 and 2 headers consist of base +;; and extension headers. For more details see +;; http://homepage1.nifty.com/dangan/en/Content/Program/Java/jLHA/Notes/Notes.html +;; http://www.osirusoft.com/joejared/lzhformat.html ;; ;; ZIP A series of (lheader,fil) followed by a "central directory" ;; which is a series of (cheader) followed by an end-of- @@ -463,18 +469,18 @@ the mode is invalid. If ERROR is nil then nil will be returned." (second (* 2 (logand time 31)))) ; 2 seconds resolution (format "%02d:%02d:%02d" hour minute second))) -;;(defun archive-unixdate (low high) -;; "Stringify unix (LOW HIGH) date." -;; (let ((str (current-time-string (cons high low)))) -;; (format "%s-%s-%s" -;; (substring str 8 9) -;; (substring str 4 7) -;; (substring str 20 24)))) +(defun archive-unixdate (low high) + "Stringify unix (LOW HIGH) date." + (let ((str (current-time-string (cons high low)))) + (format "%s-%s-%s" + (substring str 8 10) + (substring str 4 7) + (substring str 20 24)))) -;;(defun archive-unixtime (low high) -;; "Stringify unix (LOW HIGH) time." -;; (let ((str (current-time-string (cons high low)))) -;; (substring str 11 19))) +(defun archive-unixtime (low high) + "Stringify unix (LOW HIGH) time." + (let ((str (current-time-string (cons high low)))) + (substring str 11 19))) (defun archive-get-lineno () (if (>= (point) archive-file-list-start) @@ -1408,38 +1414,48 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (maxlen 8) files visual) - (while (progn (goto-char p) + (while (progn (goto-char p) ;beginning of a base header. (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-")) - (let* ((hsize (char-after p)) - (csize (archive-l-e (+ p 7) 4)) - (ucsize (archive-l-e (+ p 11) 4)) - (modtime (archive-l-e (+ p 15) 2)) - (moddate (archive-l-e (+ p 17) 2)) - (hdrlvl (char-after (+ p 20))) - (fnlen (char-after (+ p 21))) - (efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen)))) + (let* ((hsize (char-after p)) ;size of the base header (level 0 and 1) + (csize (archive-l-e (+ p 7) 4)) ;size of a compressed file to follow. + (ucsize (archive-l-e (+ p 11) 4)) ;size of an uncompressed file. + (time1 (archive-l-e (+ p 15) 2)) ;date/time (MSDOS format in level 0, 1 headers + (time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.) + (hdrlvl (char-after (+ p 20))) ;header level + thsize ;total header size (base + extensions) + fnlen efnname fiddle ifnname width p2 creator + neh ;beginning of next extension header (level 1 and 2) + mode modestr uid gid text dir prname + gname uname modtime moddate) + (if (= hdrlvl 3) (error "can't handle lzh level 3 header type")) + (when (or (= hdrlvl 0) (= hdrlvl 1)) + (setq fnlen (char-after (+ p 21))) ;filename length + (setq efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen)))) ;filename from offset 22 (if file-name-coding-system (decode-coding-string str file-name-coding-system) (string-as-multibyte str)))) - (fiddle (string= efnname (upcase efnname))) - (ifnname (if fiddle (downcase efnname) efnname)) - (width (string-width ifnname)) - (p2 (+ p 22 fnlen)) - (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) - mode modestr uid gid text dir prname - ) - (if (= hdrlvl 0) - (setq mode (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666) - uid (if (= creator ?U) (archive-l-e (+ p2 10) 2)) - gid (if (= creator ?U) (archive-l-e (+ p2 12) 2))) - (if (= creator ?U) - (let* ((p3 (+ p2 3)) - (hsize (archive-l-e p3 2)) - (etype (char-after (+ p3 2)))) - (while (not (= hsize 0)) + (setq p2 (+ p 22 fnlen))) ; + (if (= hdrlvl 1) + (progn ;specific to level 1 header + (setq creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) + (setq neh (+ p2 3))) + (if (= hdrlvl 2) + (progn ;specific to level 2 header + (setq creator (char-after (+ p 23)) ) + (setq neh (+ p 24))))) + (if neh ;if level 1 or 2 we expect extension headers to follow + (let* ((ehsize (archive-l-e neh 2)) ;size of the extension header + (etype (char-after (+ neh 2)))) ;extension type + (while (not (= ehsize 0)) (cond - ((= etype 2) (let ((i (+ p3 3))) - (while (< i (+ p3 hsize)) + ((= etype 1) ;file name + (let ((i (+ neh 3))) + (while (< i (+ neh ehsize)) + (setq efnname (concat efnname (char-to-string (char-after i)))) + (setq i (1+ i))))) + ((= etype 2) ;directory name + (let ((i (+ neh 3))) + (while (< i (+ neh ehsize)) (setq dir (concat dir (if (= (char-after i) 255) @@ -1447,15 +1463,40 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (char-to-string (char-after i))))) (setq i (1+ i))))) - ((= etype 80) (setq mode (archive-l-e (+ p3 3) 2))) - ((= etype 81) (progn (setq uid (archive-l-e (+ p3 3) 2)) - (setq gid (archive-l-e (+ p3 5) 2)))) + ((= etype 80) ;Unix file permission + (setq mode (archive-l-e (+ neh 3) 2))) + ((= etype 81) ;UNIX file group/user ID + (progn (setq uid (archive-l-e (+ neh 3) 2)) + (setq gid (archive-l-e (+ neh 5) 2)))) + ((= etype 82) ;UNIX file group name + (let ((i (+ neh 3))) + (while (< i (+ neh ehsize)) + (setq gname (concat gname (char-to-string (char-after i)))) + (setq i (1+ i))))) + ((= etype 83) ;UNIX file user name + (let ((i (+ neh 3))) + (while (< i (+ neh ehsize)) + (setq uname (concat uname (char-to-string (char-after i)))) + (setq i (1+ i))))) ) - (setq p3 (+ p3 hsize)) - (setq hsize (archive-l-e p3 2)) - (setq etype (char-after (+ p3 2))))))) + (setq neh (+ neh ehsize)) + (setq ehsize (archive-l-e neh 2)) + (setq etype (char-after (+ neh 2)))) + ;;get total header size for level 1 and 2 headers + (setq thsize (- neh p)))) + (if (= hdrlvl 0) ;total header size + (setq thsize hsize)) + (setq fiddle (string= efnname (upcase efnname))) + (setq ifnname (if fiddle (downcase efnname) efnname)) (setq prname (if dir (concat dir ifnname) ifnname)) + (setq width (string-width prname)) (setq modestr (if mode (archive-int-to-mode mode) "??????????")) + (setq moddate (if (= hdrlvl 2) + (archive-unixdate time1 time2) ;level 2 header in UNIX format + (archive-dosdate time2))) ;level 0 and 1 header in DOS format + (setq modtime (if (= hdrlvl 2) + (archive-unixtime time1 time2) + (archive-dostime time1))) (setq text (if archive-alternate-display (format " %8d %5S %5S %s" ucsize @@ -1465,18 +1506,18 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (format " %10s %8d %-11s %-8s %s" modestr ucsize - (archive-dosdate moddate) - (archive-dostime modtime) - ifnname))) + moddate + modtime + prname))) (setq maxlen (max maxlen width) totalsize (+ totalsize ucsize) visual (cons (vector text - (- (length text) (length ifnname)) + (- (length text) (length prname)) (length text)) visual) files (cons (vector prname ifnname fiddle mode (1- p)) files) - p (+ p hsize 2 csize)))) + p (+ p thsize 2 csize)))) (goto-char (point-min)) (set-buffer-multibyte default-enable-multibyte-characters) (let ((dash (concat (if archive-alternate-display |