← Back to branch summary

~ubuntu-branches/ubuntu/lucid/mew-beta/lucid

« back to all changes in this revision

Viewing changes to mew-encode.el

  • Committer: Bazaar Package Importer
  • Author(s): Tatsuya Kinoshita
  • Date: 2006-10-31 22:07:48 UTC
  • mfrom: (1.1.6 upstream) (2.1.2 etch)
  • Revision ID: james.westby@ubuntu.com-20061031220748-iq1bg528g9nt2l57
Tags: 5.1.52~0.20061031-1
New upstream release. (CVS trunk on 2006-10-31)

Show diffs side-by-side

added added

removed removed

Lines of Context:
mew-encode.el
25
25
 
26
26
(defvar mew-encode-multipart-signed-switch
27
27
  `((,mew-ct-pgs mew-pgp-sign mew-pgp-canonicalize)
28
 
    (,mew-ct-sms mew-smime-sign)))
 
28
    (,mew-ct-sms mew-smime-detach-sign)))
29
29
 
30
30
;;
31
31
 
516
516
 
517
517
(defun mew-encode-make-single ()
518
518
  ;; Just after the header
 
519
  ;; Using Multipart/Signed if the body is a single part.
 
520
  (if (equal (mew-syntax-get-privacy mew-encode-syntax)
 
521
             `((,mew-ct-smm ,mew-ct-smm-sig)))
 
522
      (mew-syntax-set-privacy mew-encode-syntax `((,mew-ct-mls ,mew-ct-sms))))
519
523
  (mew-encode-singlepart mew-encode-syntax nil nil t 'cover))
520
524
 
521
525
(defun mew-encode-charset-8bitp (charset)
539
543
(defvar mew-ask-encoding t)
540
544
(defvar mew-default-encoding mew-b64)
541
545
 
542
 
(defun mew-encode-mime-body (ctl cte file)
 
546
(defun mew-encode-mime-body (ctl cte file no-encoding)
543
547
  ;; If file is 't', target is buffered.
544
548
  ;; text should be buffered
545
549
  ;;    - specified charset is a rare case
597
601
            ;; unknown charset
598
602
            (setq cte mew-default-encoding))
599
603
        (cond
 
604
         (no-encoding
 
605
          (if (mew-encode-charset-8bitp charset)
 
606
              (setq cte mew-8bit)
 
607
            (setq cte mew-7bit)))
600
608
         (mew-inherit-7bit
601
609
          (if (mew-case-equal cte mew-8bit)
602
610
              (setq cte mew-default-encoding)))
603
611
         (mew-use-8bit
604
612
          (if (mew-encode-charset-8bitp charset)
605
613
              (setq cte mew-8bit))))
606
 
        (when (or (mew-case-equal cte mew-7bit) (mew-case-equal cte mew-8bit))
 
614
        (when (and (not no-encoding)
 
615
                   (or (mew-case-equal cte mew-7bit)
 
616
                       (mew-case-equal cte mew-8bit)))
607
617
          (save-excursion
608
618
            (goto-char beg)
609
619
            (mew-set-buffer-multibyte nil)
623
633
          (setq cte mew-8bit)
624
634
        (setq cte mew-7bit)))
625
635
     (t
 
636
      (if (and no-encoding cte (mew-case-equal cte mew-b64))
 
637
          (setq cte mew-bin))
626
638
      ;; There are 7bit ascii bodies such as 
627
639
      ;; application/pgp-encrypted and message/external-body.
628
640
      ;; If 7bit or 8bit, it should be linebase.
629
641
      (if (null cte) (setq cte mew-7bit))))
630
642
    (cond
 
643
     ((mew-case-equal cte mew-bin)
 
644
      (mew-frwlet
 
645
       mew-cs-binary mew-cs-dummy
 
646
       (mew-insert-file-contents file)))
631
647
     ((or (mew-case-equal cte mew-7bit) (mew-case-equal cte mew-8bit))
632
648
      ;; Certainly linebase here.
633
649
      (unless textp
672
688
      (mew-encode-error (concat mew-prog-mime-encode " does not exist"))))
673
689
    (list (if charset (list "charset" charset)) cte)))
674
690
 
 
691
(defun mew-encode-no-mime-encoding (privacy)
 
692
  (let ((first (car privacy)))
 
693
    (and (listp first)
 
694
         (or (string-equal (car first) mew-ct-mle)
 
695
             (string-equal (car first) mew-ct-smm)))))
 
696
 
675
697
(defun mew-encode-singlepart (syntax &optional path depth buffered coverp)
676
698
  ;; path is nil if called make-single or security multipart
677
699
  ;; buffered is t if called make-single
684
706
         (cd (mew-syntax-get-cd syntax))
685
707
         (cdpl (mew-syntax-get-cdp syntax))
686
708
         (privacy (mew-syntax-get-privacy syntax))
 
709
         (no-encoding (mew-encode-no-mime-encoding privacy))
687
710
         (mew-inherit-7bit (mew-encode-limit-7bitp privacy))
688
711
         (beg (point))
689
712
         charset-cte charset bodybeg cst ask-cst)
690
 
    (setq charset-cte (mew-encode-mime-body ctl cte (or buffered file)))
 
713
    (setq charset-cte (mew-encode-mime-body ctl cte (or buffered file) no-encoding))
691
714
    (goto-char beg)
692
715
    (mew-set '(charset cte) charset-cte)
693
716
    (setq ctl (mew-delete "icharset" ctl))
710
733
        (mew-header-delete-lines mew-field-delete-for-forwarding)))
711
734
    (when privacy
712
735
      (mew-encode-security-multipart
713
 
       beg privacy depth (mew-syntax-get-decrypters syntax)))
 
736
       beg privacy depth (mew-syntax-get-decrypters syntax) cte))
714
737
    (goto-char (point-max))
715
738
    (when (and coverp (setq cst (nth 1 charset)))
716
739
      (cond
788
811
           (mew-replace-character (current-time-string) mew-sp ?_) ?: ?_)
789
812
          (mew-random-string 3 t)))
790
813
 
791
 
(defun mew-encode-multipart (syntax path depth &optional buffered)
 
814
(defun mew-encode-multipart (syntax path depth &optional buffered cte)
792
815
  (let* ((boundary
793
816
          (mew-boundary-get ;; 0 is nil for Next_Part
794
817
           (if (> depth 0) (format "BOUNDARY%s" (number-to-string depth)))))
830
853
      (mew-header-insert mew-cte: (if (> 8bit-cnt 0) mew-8bit mew-7bit)))
831
854
    (when privacy 
832
855
      (mew-encode-security-multipart
833
 
       beg privacy depth (mew-syntax-get-decrypters syntax)))
 
856
       beg privacy depth (mew-syntax-get-decrypters syntax) cte))
834
857
    (goto-char (point-max))
835
858
    (> 8bit-cnt 0)))
836
859
 
839
862
;;; Privacy services
840
863
;;;
841
864
 
842
 
(defun mew-encode-security-multipart (beg privacy depth decrypters)
 
865
(defun mew-encode-security-multipart (beg privacy depth decrypters cte)
843
866
  (save-restriction
844
867
    (narrow-to-region beg (point-max))
845
868
    (let (proto ct)
849
872
        (setq ct (mew-capitalize ct))
850
873
        (setq privacy (cdr privacy))
851
874
        (cond 
852
 
         ((string= mew-ct-mle ct)
853
 
          (mew-encode-multipart-encrypted ct proto depth decrypters))
854
 
         ((string= mew-ct-mls ct)
855
 
          (mew-encode-multipart-signed ct proto depth)))))))
 
875
         ((string= ct mew-ct-mle)
 
876
          (mew-encode-multipart-encrypted ct proto depth decrypters cte))
 
877
         ((string= ct mew-ct-mls)
 
878
          (mew-encode-multipart-signed ct proto depth))
 
879
         ((string= ct mew-ct-smm)
 
880
          (mew-encode-smime proto cte decrypters)))))))
856
881
 
857
882
(defun mew-security-multipart-boundary (depth)
858
883
   (if depth
859
884
       (mew-boundary-get (format "Security_Multipart%s" (number-to-string depth)))
860
885
     (mew-boundary-get "Security_Multipart")))
861
886
 
862
 
(defun mew-save-transfer-form (beg end retain)
 
887
(defun mew-save-transfer-form (beg end retain &optional cte)
863
888
  ;; called in the narrowed region
864
 
  (let ((sbeg beg) (send end) (draft-buf (current-buffer)) tmpbuf file)
 
889
  (let ((sbeg beg) (send end) (draft-buf (current-buffer))
 
890
        (ocs mew-cs-text-for-net)
 
891
        tmpbuf file)
865
892
    (if retain
866
893
        (progn
867
894
          (setq tmpbuf (generate-new-buffer mew-buffer-prefix))
869
896
          (mew-erase-buffer)
870
897
          (mew-insert-buffer-substring draft-buf beg end)
871
898
          (setq sbeg (point-min) send (point-max))))
872
 
    (unless mew-cs-text-for-net
873
 
      (goto-char sbeg) ;; just in case
874
 
      (mew-lf-to-crlf)
875
 
      (setq send (point-max)))
 
899
    (goto-char sbeg) ;; just in case
 
900
    (if (and cte (mew-case-equal cte mew-bin)
 
901
             (re-search-forward mew-eoh))
 
902
        (progn
 
903
          (setq ocs mew-cs-binary)
 
904
          (forward-line)
 
905
          (save-restriction
 
906
            (narrow-to-region sbeg (point))
 
907
            (goto-char sbeg)
 
908
            (mew-lf-to-crlf)))
 
909
      (unless mew-cs-text-for-net
 
910
        (goto-char sbeg) ;; just in case
 
911
        (mew-lf-to-crlf)))
 
912
    (setq send (point-max))
876
913
    (setq file (mew-make-temp-name))
877
914
    (mew-frwlet
878
 
     mew-cs-dummy mew-cs-text-for-net
 
915
     mew-cs-dummy ocs
879
916
     (write-region sbeg send file nil 'no-msg))
880
917
    (if retain
881
918
        (mew-remove-buffer tmpbuf)
883
920
    (set-buffer draft-buf)
884
921
    file)) ;; return value
885
922
 
886
 
(defun mew-encode-multipart-encrypted (ct proto depth decrypters)
 
923
(defun mew-encode-multipart-encrypted (ct proto depth decrypters cte)
887
924
  ;; called in the narrowed region
888
925
  (let* ((boundary (mew-security-multipart-boundary depth))
889
926
         (switch mew-encode-multipart-encrypted-switch) ;; save length
890
927
         (func (mew-encode-get-security-func proto switch))
891
928
         file1 file2 file3 cte2 cte3 fc errmsg)
892
 
    (if mew-encrypt-to-myself
 
929
    (if (and mew-encrypt-to-myself
 
930
             (not (member mew-inherit-encode-signer decrypters)))
893
931
        (setq decrypters (cons mew-inherit-encode-signer decrypters)))
894
932
    ;; Write the part converting line breaks.
895
 
    (setq file1 (mew-save-transfer-form (point-min) (point-max) nil))
 
933
    (setq file1 (mew-save-transfer-form (point-min) (point-max) nil cte))
896
934
    ;; The narrowed region stores nothing
897
935
    ;; Call the protocol function
898
936
    (condition-case nil
916
954
      (mew-header-insert mew-ct: (list ct
917
955
                                       (list "protocol" proto)
918
956
                                       (list "boundary" boundary)))
919
 
      (mew-header-insert mew-cte: "7bit")
 
957
      (mew-header-insert mew-cte: mew-7bit)
920
958
      (insert (format "\n--%s\n" boundary))
921
959
      ;; Insert control keys
922
960
      (mew-encode-singlepart 
965
1003
                                       (list "protocol" proto)
966
1004
                                       (list "micalg" micalg)
967
1005
                                       (list "boundary" boundary)))
968
 
      (mew-header-insert mew-cte: "7bit")
 
1006
      (mew-header-insert mew-cte: mew-7bit)
969
1007
      (insert (format "\n--%s\n" boundary))
970
1008
      (goto-char (point-max))
971
1009
      ;; After the signed part