ezmlm-web/ezmlm-web-modules
3
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

adapted to newer gpgpy-ezmlm

Browse source
This commit is contained in:
lars 2007-03-26 19:30:25 +00:00
parent 007dba196e
commit 3b9e364756
1 changed files with 154 additions and 179 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

333
gpg-Ezmlm/trunk/Gpg.pm
View file

@ -31,15 +31,6 @@ use vars qw(@GPG_LIST_OPTIONS);
use Carp; use Carp;
use Crypt::GPG; use Crypt::GPG;
require Exporter;
@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
);
$VERSION = '0.1'; $VERSION = '0.1';
require 5.005; require 5.005;
@ -58,29 +49,15 @@ The rest is a bit complicated for a Synopsis, see the description.
=head1 DESCRIPTION =head1 DESCRIPTION
Mail::Ezmlm::Gpg is a Perl module that is designed to provide an object Mail::Ezmlm::Gpg is a Perl module that is designed to provide an object
interface to encrypted mailing lists based upon gpg-ezmlm. interface to encrypted mailing lists based upon gpgpy-ezmlm.
See the ezmlm web page (http://www.synacklabs.net/projects/crypt-ml/) for See the gpgpy-ezmlm web page (https://systemausfall.org/toolforge/gpgpy-ezmlm/)
a this software. for a this software.
=cut =cut
# == Begin site dependant variables == # == Begin site dependant variables ==
$GPG_EZMLM_BASE = '/usr/bin'; # Autoinserted by Makefile.PL
$GPG_BIN = '/usr/bin/gpg'; # Autoinserted by Makefile.PL $GPG_BIN = '/usr/bin/gpg'; # Autoinserted by Makefile.PL
# == check the ezmlm-make path ==
$GPG_EZMLM_BASE = '/usr/local/bin/ezmlm'
unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/local/bin/ezmlm-idx'
unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/local/bin'
unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/bin/ezmlm'
unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/bin/ezmlm-idx'
unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/bin'
unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
# == check the gpg path == # == check the gpg path ==
$GPG_BIN = '/usr/local/bin/gpg' $GPG_BIN = '/usr/local/bin/gpg'
@ -101,18 +78,15 @@ $GPG_BIN = '/bin/gpg'
unless (-e "$GPG_BIN"); unless (-e "$GPG_BIN");
# == clean up the path for taint checking == # == clean up the path for taint checking ==
local $ENV{'PATH'} = $GPG_EZMLM_BASE; local $ENV{'PATH'} = "/bin";
# == define the available (supported) GPG_LIST_OPTIONS == # == define the available (supported) GPG_LIST_OPTIONS ==
@GPG_LIST_OPTIONS = ( my %GPGPY_DEFAULT_OPTIONS = (
"RequireSub", "plain_without_key" => 0,
"requireSigs", "sign_messages" => 0,
"NokeyNocrypt", "gnupg_dir" => ".gnupg" );
"signMessages",
"encryptToAll",
"VerifiedKeyReq",
"allowKeySubmission");
my $GPGPY_CONF_FILE = 'conf-gpgpy';
# == Initialiser - Returns a reference to the object == # == Initialiser - Returns a reference to the object ==
@ -143,106 +117,97 @@ sub new {
You have to create a normal list before you can convert it. You have to create a normal list before you can convert it.
Use Mail::Ezmlm to do this. Use Mail::Ezmlm to do this.
$list->convert_to_encrypted(); $list->enable_encryption();
=cut =cut
sub convert_to_encrypted { sub enable_encryption {
my($self) = @_; my($self) = @_;
my $errorstring;
my $list_dir = $self->{'LIST_NAME'}; my $list_dir = $self->{'LIST_NAME'};
($self->_seterror(-1, 'must define directory in convert_to_encrypted()') && return 0)
unless(defined($list_dir));
($self->_seterror(-1, 'directory does not exist: ' . $list_dir) && return 0)
unless(-d $list_dir);
my $tlist = new Mail::Ezmlm::Gpg($list_dir);
($self->_seterror(-1, 'list is already encrypted: ' . $list_dir) && return 0)
if ($tlist->is_gpg());
# retrieve location of dotqmail-files unless (defined($list_dir)) {
my $dot_loc; $errorstring = 'must define directory in enable_encrypted()';
if (-r "$list_dir/dot") { $self->_seterror(-1, $errorstring);
open DOT, "<$list_dir/dot"; warn $errorstring;
$dot_loc = <DOT>; return (1==0);
close DOC;
} elsif (-r "$list_dir/config") {
open CONFIG, "<$list_dir/config";
my @lines = <CONFIG>;
my $one_line;
foreach $one_line (@lines) {
$dot_loc = $1 if( $one_line =~ m/^T:(.*)$/);
}
close CONFIG;
} else {
$self->_seterror(-1, 'list configuration file not found: ' . $list_dir);
return 0;
} }
chomp($dot_loc);
$dot_loc =~ m/^([\w\._\/-]*)$/;
$dot_loc = $1;
($self->_seterror(-1, 'dotqmail files not found: ' . $dot_loc) && return 0) unless(-d $list_dir) {
unless(($dot_loc ne '') && (-e $dot_loc)); $errorstring = 'directory does not exist: ' . $list_dir;
$self->_seterror(-1, $errorstring);
warn $errorstring;
return (1==0);
}
system("$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl", "--quiet", "--skip-keygen", $list_dir, $dot_loc) == 0 if ($self->is_encrypted()) {
|| ($self->_seterror($?) && return undef); $errorstring = 'list is already encrypted: ' . $list_dir;
$self->_seterror(-1, $errorstring);
warn $errorstring;
return (1==0);
}
# create config file - this enables encryption support
unless (open(CONFIG_FILE, ">$list_dir/$GPGPY_CONF_FILE")) {
$errorstring = "failed to create config file: $list_dir/$GPGPY_CONF_FILE";
$self->_seterror(-1, $errorstring);
warn $errorstring;
return (1==0);
}
close(CONFIG_FILE);
# we write the default values to the file - this is easier to read for humans
return (1==0) unless ($self->update(%GPGPY_DEFAULT_OPTIONS));
$self->_seterror(undef); $self->_seterror(undef);
return $self->setlist($list_dir); return (0==0);
} }
# == convert an encrypted list back to plaintext == # == convert an encrypted list back to plaintext ==
=head2 Converting an encryted mailing list to a plaintext list: =head2 Converting an encryted mailing list to a plaintext list:
$list->convert_to_plaintext(); $list->disable_encryption();
=cut =cut
sub convert_to_plaintext { sub disable_encryption {
my($self) = @_; my($self) = @_;
my $errorstring;
my $list_dir = $self->{'LIST_NAME'}; my $list_dir = $self->{'LIST_NAME'};
($self->_seterror(-1, 'must define directory in convert_to_plaintext()') && return 0)
unless(defined($list_dir));
($self->_seterror(-1, 'directory does not exist: ' . $list_dir) && return 0)
unless(-d $list_dir);
my $tlist = new Mail::Ezmlm::Gpg($list_dir);
($self->_seterror(-1, 'list is not encrypted: ' . $list_dir) && return 0)
unless ($tlist->is_gpg());
unless (defined($list_dir)) {
# retrieve location of dotqmail-files $errorstring = 'must define directory in disable_encrypted()';
my $dot_loc; $self->_seterror(-1, $errorstring);
if (-r "$list_dir/dot") { warn $errorstring;
open DOT, "<$list_dir/dot"; return (1==0);
$dot_loc = <DOT>;
close DOC;
} elsif (-r "$list_dir/config.no-gpg") {
open CONFIG, "<$list_dir/config.no-gpg";
my @lines = <CONFIG>;
my $one_line;
foreach $one_line (@lines) {
$dot_loc = $1 if( $one_line =~ m/^T:(.*)$/);
}
close CONFIG;
} else {
$self->_seterror(-1, 'list configuration file not found: ' . $list_dir);
return 0;
} }
chomp($dot_loc);
$dot_loc =~ m/^([\w\._\/-]*)$/;
$dot_loc = $1;
($self->_seterror(-1, 'dotqmail files not found: ' . $dot_loc) && return 0) unless(-d $list_dir) {
unless(($dot_loc ne '') && (-e $dot_loc)); $errorstring = 'directory does not exist: ' . $list_dir;
$self->_seterror(-1, $errorstring);
warn $errorstring;
return (1==0);
}
system("$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl", "--quiet", "--revert", $list_dir, $dot_loc) == 0 unless ($self->is_encrypted()) {
|| ($self->_seterror($?) && return undef); $errorstring = 'list is not encrypted: ' . $list_dir;
$self->_seterror(-1, $errorstring);
warn $errorstring;
return (1==0);
}
unless (unlink("$list_dir/$GPGPY_CONF_FILE")) {
$errorstring = "failed to remove config file: $list_dir/$GPGPY_CONF_FILE";
$self->_seterror(-1, $errorstring);
warn $errorstring;
return (1==0);
}
$self->_seterror(undef); $self->_seterror(undef);
return $self->setlist($list_dir); return (0==0);
} }
# == Update the current list == # == Update the current list ==
@ -256,16 +221,20 @@ sub convert_to_plaintext {
sub update { sub update {
my($self, %switches) = @_; my($self, %switches) = @_;
my %ok_switches; my %ok_switches;
my ($one_key, $ok_key, $errorstring);
# check for important files: 'config' # check for important files: 'conf-gpgpy'
($self->_seterror(-1, "$self->{'LIST_NAME'} does not appear to be a valid list in update()") && return 0) unless((-e "$self->{'LIST_NAME'}/config") || (-e "$self->{'LIST_NAME'}/flags")); unless ((-e "$self->{'LIST_NAME'}/config") || (-e "$self->{'LIST_NAME'}/lock")) {
$errorstring = "$self->{'LIST_NAME'} does not appear to be a valid list in update()";
$self->_seterror(-1, $errorstring);
warn $errorstring;
return (0==1);
}
# check if all supplied settings are supported # check if all supplied settings are supported
# btw we change the case (upper/lower) of the setting to the default one # btw we change the case (upper/lower) of the setting to the default one
my $one_key;
foreach $one_key (keys %switches) { foreach $one_key (keys %switches) {
my $ok_key; foreach $ok_key (keys %GPGPY_DEFAULT_OPTIONS) {
foreach $ok_key (@GPG_LIST_OPTIONS) {
if ($ok_key =~ /^$one_key$/i) { if ($ok_key =~ /^$one_key$/i) {
$ok_switches{$ok_key} = $switches{$one_key}; $ok_switches{$ok_key} = $switches{$one_key};
delete $switches{$one_key}; delete $switches{$one_key};
@ -279,9 +248,8 @@ sub update {
} }
} }
my $errorstring; my $config_file_old = "$self->{'LIST_NAME'}/$GPGPY_CONF_FILE";
my $config_file_old = "$self->{'LIST_NAME'}/config"; my $config_file_new = "$self->{'LIST_NAME'}/$GPGPY_CONF_FILE.new";
my $config_file_new = "$self->{'LIST_NAME'}/config.new";
if(open(CONFIG_OLD, "<$config_file_old")) { if(open(CONFIG_OLD, "<$config_file_old")) {
if(open(CONFIG_NEW, ">$config_file_new")) { if(open(CONFIG_NEW, ">$config_file_new")) {
my ($in_line, $one_opt, $one_val, $new_setting); my ($in_line, $one_opt, $one_val, $new_setting);
@ -292,8 +260,12 @@ sub update {
while (($one_opt, $one_val) = each(%ok_switches)) { while (($one_opt, $one_val) = each(%ok_switches)) {
# is this the right line (maybe commented out)? # is this the right line (maybe commented out)?
if ($in_line =~ m/^#?\w*$one_opt/i) { if ($in_line =~ m/^#?\w*$one_opt/i) {
print CONFIG_NEW "$one_opt "; print CONFIG_NEW "$one_opt = ";
print CONFIG_NEW ($one_val)? "yes" : "no"; if ($one_opt eq "gnupg_dir") {
print CONFIG_NEW $one_val;
} else {
print CONFIG_NEW ($one_val)? "yes" : "no";
}
print CONFIG_NEW "\n"; print CONFIG_NEW "\n";
delete $ok_switches{$one_opt}; delete $ok_switches{$one_opt};
$found = 1; $found = 1;
@ -307,8 +279,13 @@ sub update {
} }
# write the remaining settings to the end of the file # write the remaining settings to the end of the file
while (($one_opt, $one_val) = each(%ok_switches)) { while (($one_opt, $one_val) = each(%ok_switches)) {
print CONFIG_NEW "\n$one_opt "; print CONFIG_NEW "\n$one_opt = ";
print CONFIG_NEW ($one_val)? "yes" : "no"; # is this a non-boolean setting?
if ($one_opt eq "gnupg_dir") {
print CONFIG_NEW $one_val;
} else {
print CONFIG_NEW ($one_val)? "yes" : "no";
}
print CONFIG_NEW "\n"; print CONFIG_NEW "\n";
} }
} else { } else {
@ -325,6 +302,7 @@ sub update {
warn $errorstring; warn $errorstring;
return (1==0); return (1==0);
} }
close CONFIG_OLD; close CONFIG_OLD;
unless (rename($config_file_new, $config_file_old)) { unless (rename($config_file_new, $config_file_old)) {
$errorstring = "failed to move new config file ($config_file_new) " $errorstring = "failed to move new config file ($config_file_new) "
@ -333,6 +311,7 @@ sub update {
warn $errorstring; warn $errorstring;
return (1==0); return (1==0);
} }
$self->_seterror(undef); $self->_seterror(undef);
return (0==0); return (0==0);
} }
@ -351,32 +330,29 @@ getconfig() returns a hash including all available settings
sub getconfig { sub getconfig {
my($self) = @_; my($self) = @_;
my(%options); my(%options, $key);
# define defaults
$options{signMessages} = 1;
$options{NokeyNocrypt} = 0;
$options{allowKeySubmission} = 1;
$options{encryptToAll} = 0;
$options{VerifiedKeyReq} = 0;
$options{RequireSub} = 0;
$options{requireSigs} = 0;
foreach $key (keys %GPGPY_DEFAULT_OPTIONS) {
$options{$key} = $GPGPY_DEFAULT_OPTIONS{$key};
}
# Read the config file # Read the config file
if(open(CONFIG, "<$self->{'LIST_NAME'}/config")) { if(open(CONFIG, "<$self->{'LIST_NAME'}/$GPGPY_CONF_FILE")) {
# 'config' contains the authorative information # 'conf-gpgpy' contains the authorative information
while(<CONFIG>) { while(<CONFIG>) {
if (/^(\w+)\s(.*)$/) { if (/^(\w+)\s*=\s*(.*)$/) {
my $optname = $1; my $optname = $1;
my $optvalue = $2; my $optvalue = $2;
my $one_opt; my $one_opt;
foreach $one_opt (@GPG_LIST_OPTIONS) { foreach $one_opt (keys %GPGPY_DEFAULT_OPTIONS) {
if ($one_opt =~ m/^$optname$/i) { if ($one_opt =~ m/^$optname$/i) {
if ($optvalue =~ /^yes$/i) { if ($optname ne 'gnupg_dir') {
$options{$one_opt} = 1; # 'gnupg_dir' is the only non-boolean setting
} else { if ($optvalue =~ /^yes$/i) {
$options{$one_opt} = 0; $options{$one_opt} = 1;
} else {
$options{$one_opt} = 0;
}
} }
} }
} }
@ -391,6 +367,34 @@ sub getconfig {
return %options; return %options;
} }
# == Return the directory of the gnupg keyring of the current list ==
=head2 Retrieving the directory of the gnupg keyring of the current list
$print $list->get_gnupg_dir();
=cut
sub get_gnupg_dir {
my ($self) = shift;
my %config = $self->getconfig();
my $setting = $config{"gnupg_dir"};
$self->_seterror(undef);
# prefix the directory with the list directory if the directory is not absolute
if (substr($setting, 0, 1) eq "~") {
# nothing to be done - the "system" call for gpg will expand it via shell
return $setting;
} elsif (substr($setting, 0, 1) eq "/") {
# absolute path - this is ok, too
return $setting;
} else {
return $self->{'LIST_NAME'} . '/' . $setting;
}
}
# == Return the directory of the current list == # == Return the directory of the current list ==
@ -421,13 +425,17 @@ sub setlist {
if ($list =~ m/^([\w\d\_\-\.\/]+)$/) { if ($list =~ m/^([\w\d\_\-\.\/]+)$/) {
$list = $1; $list = $1;
if (-e "$list/lock") { if (-e "$list/lock") {
# it is an ezmlm list
# it is not necessary, that it is an encrypted list
$self->_seterror(undef); $self->_seterror(undef);
return $self->{'LIST_NAME'} = $list; return $self->{'LIST_NAME'} = $list;
} else { } else {
# not an ezmlm list
$self->_seterror(-1, "$list does not appear to be a valid list in setlist()"); $self->_seterror(-1, "$list does not appear to be a valid list in setlist()");
return undef; return undef;
} }
} else { } else {
# invalid characters
$self->_seterror(-1, "$list contains tainted data in setlist()"); $self->_seterror(-1, "$list contains tainted data in setlist()");
return undef; return undef;
} }
@ -438,54 +446,21 @@ sub setlist {
=head2 Checking the state of a list: =head2 Checking the state of a list:
To determine, if a list is encrypted or not, call is_gpg(). To determine, if a list is encrypted or not, call is_encrypted().
$list->is_gpg(); $list->is_encrypted();
=cut =cut
sub is_gpg { sub is_encrypted {
my($self) = @_; my($self) = @_;
($self->_seterror(-1, 'must setlist() before is_gpg()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before is_encrypted()') && return 0) unless(defined($self->{'LIST_NAME'}));
$self->_seterror(undef); $self->_seterror(undef);
return (0==1) unless (-e "$self->{'LIST_NAME'}/config"); if (-e "$self->{'LIST_NAME'}/$GPGPY_CONF_FILE") {
my $content = $self->getpart("config"); return (0==0);
# return false if we encounter the usual ezmlm-idx-v0.4-header } else {
return (0==1) if ($content =~ /^F:/m); return (1==0);
return (0==0); }
}
# == retrieve file contents ==
=head2 Getting the content of file in a mailing list directory:
@part = $list->getpart('headeradd');
$part = $list->getpart('headeradd');
getpart() can be used to retrieve the contents of various text files such as
headeradd, headerremove, mimeremove, etc.
=cut
sub getpart {
my($self, $part) = @_;
my(@contents, $content);
my $filename = $self->{'LIST_NAME'} . "/$part";
if (open(PART, "<$filename")) {
while(<PART>) {
unless ( /^#/ ) {
chomp($contents[$#contents++] = $_);
$content .= $_;
}
}
close PART;
if(wantarray) {
return @contents;
} else {
return $content;
}
} ($self->_seterror($?) && return undef);
} }
@ -642,7 +617,7 @@ sub get_secret_keys {
# == check version of gpg-ezmlm == # == check version of gpg-ezmlm ==
sub check_gpg_ezmlm_version { sub check_gpgpy_ezmlm_version {
my $ret_value = system("'$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl' --version &>/dev/null"); my $ret_value = system("'$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl' --version &>/dev/null");
# for now we do not need a specific version of gpg-ezmlm - it just has to # for now we do not need a specific version of gpg-ezmlm - it just has to
# know the "--version" argument (available since gpg-ezmlm 0.3.4) # know the "--version" argument (available since gpg-ezmlm 0.3.4)
@ -656,7 +631,7 @@ sub check_gpg_ezmlm_version {
sub _get_gpg_object() { sub _get_gpg_object() {
my ($self) = @_; my ($self) = @_;
my $gpg = new Crypt::GPG(); my $gpg = new Crypt::GPG();
my $dirname = $self->{'LIST_NAME'} . '/.gnupg'; my $dirname = $self->get_gnupg_dir();
# fix spaces in filename # fix spaces in filename
$dirname =~ s/ /\\ /g; $dirname =~ s/ /\\ /g;
$gpg->gpgbin($GPG_BIN); $gpg->gpgbin($GPG_BIN);