🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: fj.mail
Article #397

Re: MIME encoded headers (Re: MIMEでの日本語 (多国語 )メイル )

#397
From: enami tsugutomo
Date: Sat, 18 Jul 1992 08:02
223 lines
8578 bytes
	$B8+$($J$$(B$B$N$b$7$c$/$J$N$G(B:), decode$B$9$k(Belisp program$B$r=q$$$F$_(B
	$B$^$7$?(B.  $B$I$s$J46$8$K8+(B$B$($k$N$@$m$&(B, $B$H;W$&$R$H$O;n$7$F$_$k$N(B
	$B$b$$$$$G$7$g$&(B.

	mime/decode-region $B$H(B mime/decode-message-header $B$,(B 
	interactive $B$J4X?t$G$9(B.  charset $B$O(B ISO-2022-JP, encoding $B$O(B 
	base64 $B$7$+%5%]!<%H$7$F$^$;$s(B.

# 4$B;~4VA0$K(B rfc1341 & 1342 $B$r$J$J$a$KFI$s(B$B$G=q$$$?$@$1$@$+$i(B, $B$*$+$7$J(B
# $B$H$3$m$b$-$C$H$"$k$G$7$g$&(B...
$B$($J$_(B $B$D$0(B$B$H$b(B / $B%=%K!<(B
;;
;; $Id: mime.el,v 1.5 1992/07/18 07:52:08 enami Exp enami $
;;

(defconst mime/tspecials "()<>@,;:\\\"/[]?.=")
(defconst mime/charset-regexp "[A-Za-z0-9!#$%&'*+---^_`{}|~]")
(defconst mime/base64-charset (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
				      "abcdefghijklmnopqrstuvwxyz"
				      "0123456789"
				      "+/"))
(defconst mime/base64-charset-regexp "[A-Za-z0-9+/]")
(defconst mime/base64-encoded-text-regexp (concat mime/charset-regexp
						  "+"
						  "=?=?"))
(defconst mime/encoded-word-begin "=?")
(defconst mime/encoded-word-end "?=")
(defconst mime/encoded-word-regexp (concat (regexp-quote 
					    mime/encoded-word-begin)
					   "\\("
					   mime/charset-regexp
					   "+\\)"
					   (regexp-quote "?")
					   "\\(B\\|Q\\)"
					   (regexp-quote "?")
					   "\\("
					   mime/base64-encoded-text-regexp
					   "\\)"
					   (regexp-quote 
					    mime/encoded-word-end)))

(defun mime/nth-string (s n)
  (if (stringp s)
      (substring s (match-beginning n) (match-end n))
    (buffer-substring (match-beginning n) (match-end n))))

(defun mime/rest-of-string (str)
  (if (stringp str)
      (substring str (match-end 0))
    (buffer-substring (match-end 0))))

;; (char-to-string (mime/base64-bit-to-char 26))
(defun mime/base64-bit-to-char (n)
  (cond ((eq n nil) ?=)
	((< n 26) (+ ?A n))
	((< n 52) (+ ?a (- n 26)))
	((< n 62) (+ ?0 (- n 52)))
	((= n 62) ?+)
	((= n 63) ?/)
	(t (error "not a base64 integer %d" n))))

(defun mime/base64-char-to-bit (c)
  (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
	((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
	((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
	((= c ?+) 62)
	((= c ?/) 63)
	((= c ?=) nil)
	(t (error "not a base64 character %c" c))))

(and nil
     (let ((n 0))
       (while (< n 64) 
	 (if (/= n 
		 (mime/base64-char-to-bit (mime/base64-bit-to-char n)))
	     (error "%d" n))
	 (setq n (1+ n))))
     )

(defun mime/mask (i n) (logand i (1- (ash 1 n))))
(defun mime/base64-encode-1 (a &optional b &optional c)
  (cons (ash a -2)
	(cons (logior (ash (mime/mask a 2) (- 6 2))
		      (if b (ash b -4) 0))
	      (if b
		  (cons (logior (ash (mime/mask b 4) (- 6 4))
				(if c (ash c -6) 0))
			(if c
			    (cons (mime/mask c (- 6 0))
				  nil)))))))

(defun mime/base64-decode-1 (a b &optional c &optional d)
  (cons (logior (ash a 2) (ash b (- 2 6)))
	(if c (cons (logior (ash (mime/mask b 4) 4)
			    (mime/mask (ash c (- 4 6)) 4))
		    (if d (cons (logior (ash (mime/mask c 2) 6) d)
				nil))))))
(and nil
     (let ((l '(?\e ?$ ?@)) m n)
       (setq m (mapcar (function char-to-string)
		       (mapcar (function mime/base64-bit-to-char)
			       (apply (function mime/base64-encode-1) l))))
       (setq n (mapcar (function identity)
		       (apply (function mime/base64-decode-1)
			      (mapcar (function mime/base64-char-to-bit)
				      (mapcar (function string-to-char) m)))))
       (message "%s %s %s" l m n))
     )


;; (mime/base64-decode-chars ?G ?y ?R ?A)
(defun mime/base64-decode-chars (a b c d)
  (apply (function mime/base64-decode-1)
	 (mapcar (function mime/base64-char-to-bit)
		 (list a b c d))))

;; (mapcar (function char-to-string) (mime/base64-encode-chars 27 36 64))
(defun mime/base64-encode-chars (a b c)
  (mapcar (function mime/base64-bit-to-char) (mime/base64-encode-1 a b c)))

(defun mime/base64-fecth-from (func from pos len)
  (let (ret)
    (while (< 0 len)
      (setq len (1- len)
	    ret (cons (funcall func from (+ pos len)) ret)))
    ret))

(defun mime/base64-fecth-from-buffer (from pos len)
  (mime/base64-fecth-from (function (lambda (f p) (char-after p)))
			  from pos len))

(and nil
     (mapcar (function (lambda (x) (if (integerp x) (char-to-string x)
				     x)))
	     (mime/base64-fecth-from-string "hoge" 1 4))
     )
(defun mime/base64-fecth-from-string (from pos len)
  (mime/base64-fecth-from (function (lambda (f p)
				      (if (< p (length f)) (aref f p))))
			  from pos len))

(defun mime/base64-fecth (source pos len)
  (cond ((stringp source) (mime/base64-fecth-from-string source pos len))
	(t (mime/base64-fecth-from-buffer source pos len))))

(defun mime/base64-mapconcat (func unit string)
  (let ((i 0) ret)
    (while (< i (length string))
      (setq ret 
	    (apply (function concat)
		   ret
		   (mapcar (function char-to-string)
			   (apply func (mime/base64-fecth string i unit)))))
      (setq i (+ i unit)))
    ret))

;; (mime/base64-encode-string (mime/base64-decode-string "GyRAOjRGI0stGyhK"))
(defun mime/base64-decode-string (string)
  (mime/base64-mapconcat (function mime/base64-decode-chars) 4 string))

(defun mime/base64-encode-string (string)
  (mime/base64-mapconcat (function mime/base64-encode-chars) 3 string))

(defun mime/decode-string (encoding string)
  (cond ((string= encoding "B")
	 (mime/base64-decode-string string))
	((string= encoding "Q")
	 (message "format Q is not supported")
	 string)
	(t
	 (message "unknown encoding %s" encoding)
	 string)))

(cond ((and (boundp 'MULE) MULE)
       (defun mime/convert-string-iso2022-to-emacs (string)
	 (code-convert-string string *junet* *internal*)))
      ((and (boundp 'NEMACS) NEMACS)
       (defun mime/convert-string-iso2022-to-emacs (string)
	 (convert-string-kanji-code string 2 3))))

;; (mime/decode-encoded-word "=?ISO-2022-JP?B?GyRAOjRGI0stGyhK?=")
(defun mime/decode-encoded-word (word)
  (if (string-match mime/encoded-word-regexp word)
      (let ((charset (mime/nth-string word 1))
	    (encoding (mime/nth-string word 2))
	    (text (mime/nth-string word 3)))
	(cond ((string= charset "ISO-2022-JP")
	       (mime/convert-string-iso2022-to-emacs 
		(mime/decode-string encoding text)))
	      (t word)))
    word))

(defun mime/decode-region (beg end)
  (interactive "*r")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (let (charset encoding text)
	(while (re-search-forward mime/encoded-word-regexp nil t)
	  (insert (mime/decode-encoded-word 
		   (prog1
		       (buffer-substring (match-beginning 0) (match-end 0))
		     (delete-region (match-beginning 0) (match-end 0))))))))))

(defun mime/prepare-decode-message-header ()
  (goto-char (point-min))
  (while (re-search-forward
	  (concat (regexp-quote mime/encoded-word-end)
		  "\\s +"
		  (regexp-quote mime/encoded-word-begin))
	  nil t)
    (replace-match (concat mime/encoded-word-end mime/encoded-word-begin))))

(defun mime/decode-message-header ()
  (interactive "*")
  (save-excursion
    (save-restriction
      (narrow-to-region (goto-char (point-min))
			(progn (re-search-forward "^$" nil t) (point)))
      (mime/prepare-decode-message-header)
      (mime/decode-region (point-min) (point-max)))))
Technical Details
Message-ID: <ENAMI.92Jul18170213@kitt.sys.ptg.sony.co.jp>
Path: arc1-ca.pugleaf.net!sparky!uunet!ccut!wnoc-tyo-news!scslwide!wsgw!headgw!ptggw!chihaya!enami
References: <gPoO8.ysato@etl.go.jp>

Show Full Headers
Complete Article Headers
X-Google-Language: Japanese,JIS
X-Google-Thread: 1460c1,a0baa779caac25ca
X-Google-Attributes: gid1460c1,public
X-Google-Thread: ff358,472fb210793f32cf,start
X-Google-Attributes: gidff358,public
X-Google-Thread: 106028,a0baa779caac25ca
X-Google-Attributes: gid106028,public
X-Google-ArrivalTime: 1992-07-17 21:53:30 PST
Path: arc1-ca.pugleaf.net!sparky!uunet!ccut!wnoc-tyo-news!scslwide!wsgw!headgw!ptggw!chihaya!enami
From: enami@sys.ptg.sony.co.jp (enami tsugutomo)
Newsgroups: fj.mail,fj.news.b,fj.editor.emacs
Subject: Re: MIME encoded headers (Re: MIMEでの日本語 (多国語 )メイル )
Message-ID: <ENAMI.92Jul18170213@kitt.sys.ptg.sony.co.jp>
Date: 18 Jul 92 08:02:13 GMT
References: <gPoO8.ysato@etl.go.jp>
Sender: news@sys.ptg.sony.co.jp (Usenet & System)
Distribution: fj
Organization: Sony Corp. Production Technology Development Grp. R&D Div.
Lines: 224
In-Reply-To: ysato@etl.go.jp's message of 17 Jul 92 21:06:37 GMT
X-Bytes: 7264