← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:13 2021

Filename/usr/local/lib/perl5/site_perl/mach/5.32/Crypt/SMIME.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sCrypt::SMIME::::BEGIN@4Crypt::SMIME::BEGIN@4
0000s0sCrypt::SMIME::::BEGIN@5Crypt::SMIME::BEGIN@5
0000s0sCrypt::SMIME::::BEGIN@6Crypt::SMIME::BEGIN@6
0000s0sCrypt::SMIME::::BEGIN@7Crypt::SMIME::BEGIN@7
0000s0sCrypt::SMIME::::__ANON__Crypt::SMIME::__ANON__ (xsub)
0000s0sCrypt::SMIME::::_getContentTypeCrypt::SMIME::_getContentType
0000s0sCrypt::SMIME::::_moveHeaderAndDoCrypt::SMIME::_moveHeaderAndDo
0000s0sCrypt::SMIME::::encryptCrypt::SMIME::encrypt
0000s0sCrypt::SMIME::::isEncryptedCrypt::SMIME::isEncrypted
0000s0sCrypt::SMIME::::isSignedCrypt::SMIME::isSigned
0000s0sCrypt::SMIME::::prepareSmimeMessageCrypt::SMIME::prepareSmimeMessage
0000s0sCrypt::SMIME::::signCrypt::SMIME::sign
0000s0sCrypt::SMIME::::signonlyCrypt::SMIME::signonly
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# This file is automatically generated from SMIME.pl
2# All of your changes will be lost if you edit this directly.
3package Crypt::SMIME;
4use warnings;
5use strict;
6use Exporter 'import';
7use XSLoader;
8
9our %EXPORT_TAGS = (
10 constants => [qw(
11 NO_CHECK_CERTIFICATE
12
13 FORMAT_ASN1
14 FORMAT_PEM
15 FORMAT_SMIME
16 )]
17 );
18Exporter::export_ok_tags('constants');
19
20our $VERSION = '0.27';
21
22XSLoader::load(__PACKAGE__, $VERSION);
23
241;
25
26sub sign {
27 my $this = shift;
28 my $mime = shift;
29
30 if(!defined($mime)) {
31 die __PACKAGE__."#sign: ARG[1] is not defined.\n";
32 } elsif(ref($mime)) {
33 die __PACKAGE__."#sign: ARG[1] is a Ref. [$mime]\n";
34 }
35
36 $this->_moveHeaderAndDo($mime, '_sign');
37}
38
39sub signonly {
40 my $this = shift;
41 my $mime = shift;
42
43 if(!defined($mime)) {
44 die __PACKAGE__."#signonly: ARG[1] is not defined.\n";
45 } elsif(ref($mime)) {
46 die __PACKAGE__."#signonly: ARG[1] is a Ref. [$mime]\n";
47 }
48
49 # suppose that $mime is prepared.
50 my $result = $this->_signonly($mime);
51 $result =~ s/\r?\n|\r/\r\n/g;
52 $result;
53}
54
55sub encrypt {
56 my $this = shift;
57 my $mime = shift;
58
59 if(!defined($mime)) {
60 die __PACKAGE__."#encrypt: ARG[1] is not defined.\n";
61 } elsif(ref($mime)) {
62 die __PACKAGE__."#encrypt: ARG[1] is a Ref. [$mime]\n";
63 }
64
65 $this->_moveHeaderAndDo($mime, '_encrypt');
66}
67
68sub isSigned {
69 my $this = shift;
70 my $mime = shift;
71
72 if(!defined($mime)) {
73 die __PACKAGE__."#isSigned: ARG[1] is not defined.\n";
74 } elsif(ref($mime)) {
75 die __PACKAGE__."#isSigned: ARG[1] is a Ref. [$mime]\n";
76 }
77
78 my $ctype = $this->_getContentType($mime);
79 if($ctype =~ m!^application/(?:x-)?pkcs7-mime! && $ctype =~ m!smime-type="?signed-data"?!) {
80 # signed-data署名
81 1;
82 } elsif($ctype =~ m!^multipart/signed! && $ctype =~ m!protocol="?application/(?:x-)?pkcs7-signature"?!) {
83 # 分離署名 (クリア署名)
84 1;
85 } else {
86 undef;
87 }
88}
89
90sub isEncrypted {
91 my $this = shift;
92 my $mime = shift;
93
94 if(!defined($mime)) {
95 die __PACKAGE__."#isEncrypted: ARG[1] is not defined.\n";
96 } elsif(ref($mime)) {
97 die __PACKAGE__."#isEncrypted: ARG[1] is a Ref. [$mime]\n";
98 }
99
100 my $ctype = $this->_getContentType($mime);
101 if($ctype =~ m!^application/(?:x-)?pkcs7-mime!
102 && ($ctype !~ m!smime-type=! || $ctype =~ m!smime-type="?enveloped-data"?!)) {
103 # smime-typeが存在しないか、それがenveloped-dataである。
104 1;
105 } else {
106 undef;
107 }
108}
109
110sub _moveHeaderAndDo {
111 my $this = shift;
112 my $mime = shift;
113 my $method = shift;
114
115 # Content- または MIME- で始まるヘッダはそのままに、
116 # それ以外のヘッダはmultipartのトップレベルにコピーしなければならない。
117 # (FromやTo、Subject等)
118 ($mime,my $headers) = $this->prepareSmimeMessage($mime);
119
120 my $result = $this->$method($mime);
121 $result =~ s/\r?\n|\r/\r\n/g;
122
123 # コピーしたヘッダを入れる
124 $result =~ s/\r\n\r\n/\r\n$headers\r\n/;
125 $result;
126}
127
128sub _getContentType {
129 my $this = shift;
130 my $mime = shift;
131
132 my $headkey;
133 my $headline = '';
134
135 $mime =~ s/\r?\n|\r/\r\n/g;
136 foreach my $line (split /\r\n/, $mime) {
137 if(!length($line)) {
138 return $headline;
139 } elsif($line =~ m/^([^\s:][^:]*?):\s?(.*)/) {
140 my ($key, $value) = ($1, $2);
141 $headkey = $key;
142
143 if($key =~ m/^Content-Type$/i) {
144 $headline = $value;
145 }
146 } else {
147 if($headkey =~ m/^Content-Type$/i) {
148 $headline .= "\r\n$line";
149 }
150 }
151 }
152
153 return $headline;
154}
155
156# -----------------------------------------------------------------------------
157# my ($message,$movedheader) = $smime->prepareSmimeMessage($mime);
158#
159sub prepareSmimeMessage {
160 my $this = shift;
161 my $mime = shift;
162
163 $mime =~ s/\r?\n|\r/\r\n/g;
164
165 my $move = '';
166 my $rest = '';
167 my $is_move = 0;
168 my $is_rest = 1;
169 while($mime=~/(.*\n?)/g) {
170 my $line = $1;
171 if($line eq "\r\n") { # end of header.
172 $rest .= $line . substr($mime,pos($mime));
173 last;
174 }
175 if($line=~/^(Content-|MIME-)/i) {
176 ($is_move, $is_rest) = (0,1);
177 } elsif( $line =~ /^(Subject:)/i ) {
178 ($is_move, $is_rest) = (1,1);
179 } elsif( $line =~ /^\S/ ) {
180 ($is_move, $is_rest) = (1,0);
181 }
182 $is_move and $move .= $line;
183 $is_rest and $rest .= $line;
184 }
185 ($rest,$move);
186}
187__END__