Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Projets publics
Sympa
Commits
d364c610
Unverified
Commit
d364c610
authored
Oct 02, 2021
by
IKEDA Soji
Committed by
GitHub
Oct 02, 2021
Browse files
Copyedit
parent
f5928b72
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/lib/Sympa/Tools/SMIME.pm
View file @
d364c610
...
@@ -31,47 +31,13 @@ use strict;
...
@@ -31,47 +31,13 @@ use strict;
use
warnings
;
use
warnings
;
use
English
qw(-no_match_vars)
;
use
English
qw(-no_match_vars)
;
BEGIN
{
eval
'
use Crypt::OpenSSL::X509
';
}
use
Conf
;
use
Conf
;
use
Sympa::
Log
;
use
Sympa::Tools::
Text
;
use
Sympa::Tools::
Text
;
my
$log
=
Sympa::
Log
->
instance
;
=over
=item find_keys ( $that, $operation )
Find the appropriate S/MIME keys/certs for $operation of $that.
$operation can be:
=over
=item 'sign'
return the preferred signing key/cert
=item 'decrypt'
return a list of possible decryption keys/certs
=item 'encrypt'
return the preferred encryption key/cert
=back
Returnss C<($certs, $keys)>.
For 'sign' and 'encrypt', these are strings containing the absolute filename.
For 'decrypt', these are arrayrefs containing absolute filenames.
=back
=cut
# Old name: tools::smime_find_keys()
# Old name: tools::smime_find_keys()
sub
find_keys
{
sub
find_keys
{
$log
->
syslog
('
debug2
',
'
(%s, %s)
',
@
_
);
my
$that
=
shift
||
'
*
';
my
$that
=
shift
||
'
*
';
my
$operation
=
shift
;
my
$operation
=
shift
;
...
@@ -102,8 +68,6 @@ sub find_keys {
...
@@ -102,8 +68,6 @@ sub find_keys {
my
$k
=
$c
;
my
$k
=
$c
;
$k
=~
s/\/cert\.pem/\/private_key/
;
$k
=~
s/\/cert\.pem/\/private_key/
;
unless
(
$keys
{
$k
})
{
unless
(
$keys
{
$k
})
{
$log
->
syslog
('
debug3
',
'
%s exists, but matching %s doesn
\'
t
',
$c
,
$k
);
delete
$certs
{
$c
};
delete
$certs
{
$c
};
}
}
}
}
...
@@ -112,8 +76,6 @@ sub find_keys {
...
@@ -112,8 +76,6 @@ sub find_keys {
my
$c
=
$k
;
my
$c
=
$k
;
$c
=~
s/\/private_key/\/cert\.pem/
;
$c
=~
s/\/private_key/\/cert\.pem/
;
unless
(
$certs
{
$c
})
{
unless
(
$certs
{
$c
})
{
$log
->
syslog
('
debug3
',
'
%s exists, but matching %s doesn
\'
t
',
$k
,
$c
);
delete
$keys
{
$k
};
delete
$keys
{
$k
};
}
}
}
}
...
@@ -130,31 +92,15 @@ sub find_keys {
...
@@ -130,31 +92,15 @@ sub find_keys {
$certs
=
"
$dir
/cert.pem
";
$certs
=
"
$dir
/cert.pem
";
$keys
=
"
$dir
/private_key
";
$keys
=
"
$dir
/private_key
";
}
else
{
}
else
{
$log
->
syslog
('
debug3
',
'
%s: no certs/keys found for %s
',
$that
,
$operation
);
return
undef
;
return
undef
;
}
}
}
}
$log
->
syslog
('
debug3
',
'
%s: certs/keys for %s found
',
$that
,
$operation
);
return
(
$certs
,
$keys
);
return
(
$certs
,
$keys
);
}
}
BEGIN
{
eval
'
use Crypt::OpenSSL::X509
';
}
# IN: hashref:
# file => filename
# text => PEM-encoded cert
# OUT: hashref
# email => email address from cert
# subject => distinguished name
# purpose => hashref
# enc => true if v3 purpose is encryption
# sign => true if v3 purpose is signing
#
# Old name: tools::smime_parse_cert()
# Old name: tools::smime_parse_cert()
sub
parse_cert
{
sub
parse_cert
{
$log
->
syslog
('
debug3
',
'
(%s => %s)
',
@
_
);
my
%arg
=
@_
;
my
%arg
=
@_
;
return
undef
unless
$
Crypt::OpenSSL::X509::
VERSION
;
return
undef
unless
$
Crypt::OpenSSL::X509::
VERSION
;
...
@@ -166,11 +112,9 @@ sub parse_cert {
...
@@ -166,11 +112,9 @@ sub parse_cert {
}
elsif
(
$arg
{'
file
'})
{
}
elsif
(
$arg
{'
file
'})
{
$x509
=
eval
{
Crypt::OpenSSL::
X509
->
new_from_file
(
$arg
{'
file
'})
};
$x509
=
eval
{
Crypt::OpenSSL::
X509
->
new_from_file
(
$arg
{'
file
'})
};
}
else
{
}
else
{
$log
->
syslog
('
err
',
'
Neither "text" nor "file" given
');
die
'
bug in logic. Ask developer
';
return
undef
;
}
}
unless
(
$x509
)
{
unless
(
$x509
)
{
$log
->
syslog
('
err
',
'
Cannot parse certificate
');
return
undef
;
return
undef
;
}
}
...
@@ -193,34 +137,106 @@ sub parse_cert {
...
@@ -193,34 +137,106 @@ sub parse_cert {
return
\
%res
;
return
\
%res
;
}
}
# NO LONGER USED
# However, this function may be useful because it can extract messages openssl
# can not (e.g. signature part not encoded by BASE64).
sub
smime_extract_certs
{
my
(
$mime
,
$outfile
)
=
@_
;
$log
->
syslog
('
debug2
',
'
(%s)
',
$mime
->
mime_type
);
if
(
$mime
->
mime_type
=~
/application\/(x-)?pkcs7-/
)
{
my
$pipeout
;
unless
(
open
$pipeout
,
'
|-
',
$
Conf::
Conf
{
openssl
},
'
pkcs7
',
'
-print_certs
',
'
-inform
'
=>
'
der
',
'
-out
'
=>
$outfile
)
{
$log
->
syslog
('
err
',
'
Unable to run openssl pkcs7: %m
');
return
0
;
}
print
$pipeout
$mime
->
bodyhandle
->
as_string
;
close
$pipeout
;
my
$status
=
$CHILD_ERROR
>>
8
;
if
(
$status
)
{
$log
->
syslog
('
err
',
'
Openssl pkcs7 returned an error: %s
',
$status
);
return
0
;
}
return
1
;
}
}
1
;
1
;
__END__
=encoding utf-8
=head1 NAME
Sympa::Tools::SMIME - Tools for S/MIME messages and X.509 certificates
=head1 DESCRIPTION
=head2 Functions
=over
=item find_keys ( $that, $operation )
Find the appropriate S/MIME keys/certs for $operation of $that.
$operation can be:
=over
=item 'sign'
return the preferred signing key/cert
=item 'decrypt'
return a list of possible decryption keys/certs
=item 'encrypt'
return the preferred encryption key/cert
=back
Returnss C<($certs, $keys)>.
For 'sign' and 'encrypt', these are strings containing the absolute filename.
For 'decrypt', these are arrayrefs containing absolute filenames.
=item parse_cert ( C<text>|C<file> =E<gt> $content )
Parses X.509 certificate.
Options:
=over
=item C<file> =E<gt> $filename
=item C<text> =E<gt> $text
Specifies PEM-encoded certificate.
=back
Returns a hashref containing these items:
=over
=item {email}
hashref with email addresses from cert as keys
=item {emails}
arrayref with email addresses from cert.
This was added on Sympa 6.2.67b.
=item {subject}
distinguished name
=item {purpose}
hashref containing:
=over
=item {enc}
true if v3 purpose is encryption
=item {sign}
true if v3 purpose is signing
=back
=item TBD.
=back
If parsing failed, returns C<undef>.
=back
=head1 HISTORY
TBD.
=cut
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment