renamed gpg-Ezmlm to Ezmlm-Gpg
This commit is contained in:
parent
662f2969f3
commit
e4d82256e7
8 changed files with 0 additions and 0 deletions
340
Ezmlm-Gpg/trunk/COPYING
Normal file
340
Ezmlm-Gpg/trunk/COPYING
Normal file
|
@ -0,0 +1,340 @@
|
|||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 2, June 1991
|
||||
|
||||
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
|
||||
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
The licenses for most software are designed to take away your
|
||||
freedom to share and change it. By contrast, the GNU General Public
|
||||
License is intended to guarantee your freedom to share and change free
|
||||
software--to make sure the software is free for all its users. This
|
||||
General Public License applies to most of the Free Software
|
||||
Foundation's software and to any other program whose authors commit to
|
||||
using it. (Some other Free Software Foundation software is covered by
|
||||
the GNU Library General Public License instead.) You can apply it to
|
||||
your programs, too.
|
||||
|
||||
When we speak of free software, we are referring to freedom, not
|
||||
price. Our General Public Licenses are designed to make sure that you
|
||||
have the freedom to distribute copies of free software (and charge for
|
||||
this service if you wish), that you receive source code or can get it
|
||||
if you want it, that you can change the software or use pieces of it
|
||||
in new free programs; and that you know you can do these things.
|
||||
|
||||
To protect your rights, we need to make restrictions that forbid
|
||||
anyone to deny you these rights or to ask you to surrender the rights.
|
||||
These restrictions translate to certain responsibilities for you if you
|
||||
distribute copies of the software, or if you modify it.
|
||||
|
||||
For example, if you distribute copies of such a program, whether
|
||||
gratis or for a fee, you must give the recipients all the rights that
|
||||
you have. You must make sure that they, too, receive or can get the
|
||||
source code. And you must show them these terms so they know their
|
||||
rights.
|
||||
|
||||
We protect your rights with two steps: (1) copyright the software, and
|
||||
(2) offer you this license which gives you legal permission to copy,
|
||||
distribute and/or modify the software.
|
||||
|
||||
Also, for each author's protection and ours, we want to make certain
|
||||
that everyone understands that there is no warranty for this free
|
||||
software. If the software is modified by someone else and passed on, we
|
||||
want its recipients to know that what they have is not the original, so
|
||||
that any problems introduced by others will not reflect on the original
|
||||
authors' reputations.
|
||||
|
||||
Finally, any free program is threatened constantly by software
|
||||
patents. We wish to avoid the danger that redistributors of a free
|
||||
program will individually obtain patent licenses, in effect making the
|
||||
program proprietary. To prevent this, we have made it clear that any
|
||||
patent must be licensed for everyone's free use or not licensed at all.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow.
|
||||
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||
|
||||
0. This License applies to any program or other work which contains
|
||||
a notice placed by the copyright holder saying it may be distributed
|
||||
under the terms of this General Public License. The "Program", below,
|
||||
refers to any such program or work, and a "work based on the Program"
|
||||
means either the Program or any derivative work under copyright law:
|
||||
that is to say, a work containing the Program or a portion of it,
|
||||
either verbatim or with modifications and/or translated into another
|
||||
language. (Hereinafter, translation is included without limitation in
|
||||
the term "modification".) Each licensee is addressed as "you".
|
||||
|
||||
Activities other than copying, distribution and modification are not
|
||||
covered by this License; they are outside its scope. The act of
|
||||
running the Program is not restricted, and the output from the Program
|
||||
is covered only if its contents constitute a work based on the
|
||||
Program (independent of having been made by running the Program).
|
||||
Whether that is true depends on what the Program does.
|
||||
|
||||
1. You may copy and distribute verbatim copies of the Program's
|
||||
source code as you receive it, in any medium, provided that you
|
||||
conspicuously and appropriately publish on each copy an appropriate
|
||||
copyright notice and disclaimer of warranty; keep intact all the
|
||||
notices that refer to this License and to the absence of any warranty;
|
||||
and give any other recipients of the Program a copy of this License
|
||||
along with the Program.
|
||||
|
||||
You may charge a fee for the physical act of transferring a copy, and
|
||||
you may at your option offer warranty protection in exchange for a fee.
|
||||
|
||||
2. You may modify your copy or copies of the Program or any portion
|
||||
of it, thus forming a work based on the Program, and copy and
|
||||
distribute such modifications or work under the terms of Section 1
|
||||
above, provided that you also meet all of these conditions:
|
||||
|
||||
a) You must cause the modified files to carry prominent notices
|
||||
stating that you changed the files and the date of any change.
|
||||
|
||||
b) You must cause any work that you distribute or publish, that in
|
||||
whole or in part contains or is derived from the Program or any
|
||||
part thereof, to be licensed as a whole at no charge to all third
|
||||
parties under the terms of this License.
|
||||
|
||||
c) If the modified program normally reads commands interactively
|
||||
when run, you must cause it, when started running for such
|
||||
interactive use in the most ordinary way, to print or display an
|
||||
announcement including an appropriate copyright notice and a
|
||||
notice that there is no warranty (or else, saying that you provide
|
||||
a warranty) and that users may redistribute the program under
|
||||
these conditions, and telling the user how to view a copy of this
|
||||
License. (Exception: if the Program itself is interactive but
|
||||
does not normally print such an announcement, your work based on
|
||||
the Program is not required to print an announcement.)
|
||||
|
||||
These requirements apply to the modified work as a whole. If
|
||||
identifiable sections of that work are not derived from the Program,
|
||||
and can be reasonably considered independent and separate works in
|
||||
themselves, then this License, and its terms, do not apply to those
|
||||
sections when you distribute them as separate works. But when you
|
||||
distribute the same sections as part of a whole which is a work based
|
||||
on the Program, the distribution of the whole must be on the terms of
|
||||
this License, whose permissions for other licensees extend to the
|
||||
entire whole, and thus to each and every part regardless of who wrote it.
|
||||
|
||||
Thus, it is not the intent of this section to claim rights or contest
|
||||
your rights to work written entirely by you; rather, the intent is to
|
||||
exercise the right to control the distribution of derivative or
|
||||
collective works based on the Program.
|
||||
|
||||
In addition, mere aggregation of another work not based on the Program
|
||||
with the Program (or with a work based on the Program) on a volume of
|
||||
a storage or distribution medium does not bring the other work under
|
||||
the scope of this License.
|
||||
|
||||
3. You may copy and distribute the Program (or a work based on it,
|
||||
under Section 2) in object code or executable form under the terms of
|
||||
Sections 1 and 2 above provided that you also do one of the following:
|
||||
|
||||
a) Accompany it with the complete corresponding machine-readable
|
||||
source code, which must be distributed under the terms of Sections
|
||||
1 and 2 above on a medium customarily used for software interchange; or,
|
||||
|
||||
b) Accompany it with a written offer, valid for at least three
|
||||
years, to give any third party, for a charge no more than your
|
||||
cost of physically performing source distribution, a complete
|
||||
machine-readable copy of the corresponding source code, to be
|
||||
distributed under the terms of Sections 1 and 2 above on a medium
|
||||
customarily used for software interchange; or,
|
||||
|
||||
c) Accompany it with the information you received as to the offer
|
||||
to distribute corresponding source code. (This alternative is
|
||||
allowed only for noncommercial distribution and only if you
|
||||
received the program in object code or executable form with such
|
||||
an offer, in accord with Subsection b above.)
|
||||
|
||||
The source code for a work means the preferred form of the work for
|
||||
making modifications to it. For an executable work, complete source
|
||||
code means all the source code for all modules it contains, plus any
|
||||
associated interface definition files, plus the scripts used to
|
||||
control compilation and installation of the executable. However, as a
|
||||
special exception, the source code distributed need not include
|
||||
anything that is normally distributed (in either source or binary
|
||||
form) with the major components (compiler, kernel, and so on) of the
|
||||
operating system on which the executable runs, unless that component
|
||||
itself accompanies the executable.
|
||||
|
||||
If distribution of executable or object code is made by offering
|
||||
access to copy from a designated place, then offering equivalent
|
||||
access to copy the source code from the same place counts as
|
||||
distribution of the source code, even though third parties are not
|
||||
compelled to copy the source along with the object code.
|
||||
|
||||
4. You may not copy, modify, sublicense, or distribute the Program
|
||||
except as expressly provided under this License. Any attempt
|
||||
otherwise to copy, modify, sublicense or distribute the Program is
|
||||
void, and will automatically terminate your rights under this License.
|
||||
However, parties who have received copies, or rights, from you under
|
||||
this License will not have their licenses terminated so long as such
|
||||
parties remain in full compliance.
|
||||
|
||||
5. You are not required to accept this License, since you have not
|
||||
signed it. However, nothing else grants you permission to modify or
|
||||
distribute the Program or its derivative works. These actions are
|
||||
prohibited by law if you do not accept this License. Therefore, by
|
||||
modifying or distributing the Program (or any work based on the
|
||||
Program), you indicate your acceptance of this License to do so, and
|
||||
all its terms and conditions for copying, distributing or modifying
|
||||
the Program or works based on it.
|
||||
|
||||
6. Each time you redistribute the Program (or any work based on the
|
||||
Program), the recipient automatically receives a license from the
|
||||
original licensor to copy, distribute or modify the Program subject to
|
||||
these terms and conditions. You may not impose any further
|
||||
restrictions on the recipients' exercise of the rights granted herein.
|
||||
You are not responsible for enforcing compliance by third parties to
|
||||
this License.
|
||||
|
||||
7. If, as a consequence of a court judgment or allegation of patent
|
||||
infringement or for any other reason (not limited to patent issues),
|
||||
conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot
|
||||
distribute so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you
|
||||
may not distribute the Program at all. For example, if a patent
|
||||
license would not permit royalty-free redistribution of the Program by
|
||||
all those who receive copies directly or indirectly through you, then
|
||||
the only way you could satisfy both it and this License would be to
|
||||
refrain entirely from distribution of the Program.
|
||||
|
||||
If any portion of this section is held invalid or unenforceable under
|
||||
any particular circumstance, the balance of the section is intended to
|
||||
apply and the section as a whole is intended to apply in other
|
||||
circumstances.
|
||||
|
||||
It is not the purpose of this section to induce you to infringe any
|
||||
patents or other property right claims or to contest validity of any
|
||||
such claims; this section has the sole purpose of protecting the
|
||||
integrity of the free software distribution system, which is
|
||||
implemented by public license practices. Many people have made
|
||||
generous contributions to the wide range of software distributed
|
||||
through that system in reliance on consistent application of that
|
||||
system; it is up to the author/donor to decide if he or she is willing
|
||||
to distribute software through any other system and a licensee cannot
|
||||
impose that choice.
|
||||
|
||||
This section is intended to make thoroughly clear what is believed to
|
||||
be a consequence of the rest of this License.
|
||||
|
||||
8. If the distribution and/or use of the Program is restricted in
|
||||
certain countries either by patents or by copyrighted interfaces, the
|
||||
original copyright holder who places the Program under this License
|
||||
may add an explicit geographical distribution limitation excluding
|
||||
those countries, so that distribution is permitted only in or among
|
||||
countries not thus excluded. In such case, this License incorporates
|
||||
the limitation as if written in the body of this License.
|
||||
|
||||
9. The Free Software Foundation may publish revised and/or new versions
|
||||
of the General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the Program
|
||||
specifies a version number of this License which applies to it and "any
|
||||
later version", you have the option of following the terms and conditions
|
||||
either of that version or of any later version published by the Free
|
||||
Software Foundation. If the Program does not specify a version number of
|
||||
this License, you may choose any version ever published by the Free Software
|
||||
Foundation.
|
||||
|
||||
10. If you wish to incorporate parts of the Program into other free
|
||||
programs whose distribution conditions are different, write to the author
|
||||
to ask for permission. For software which is copyrighted by the Free
|
||||
Software Foundation, write to the Free Software Foundation; we sometimes
|
||||
make exceptions for this. Our decision will be guided by the two goals
|
||||
of preserving the free status of all derivatives of our free software and
|
||||
of promoting the sharing and reuse of software generally.
|
||||
|
||||
NO WARRANTY
|
||||
|
||||
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
||||
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
||||
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
||||
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
||||
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
||||
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
||||
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
||||
REPAIR OR CORRECTION.
|
||||
|
||||
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
||||
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
||||
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
||||
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
||||
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
||||
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGES.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
How to Apply These Terms to Your New Programs
|
||||
|
||||
If you develop a new program, and you want it to be of the greatest
|
||||
possible use to the public, the best way to achieve this is to make it
|
||||
free software which everyone can redistribute and change under these terms.
|
||||
|
||||
To do so, attach the following notices to the program. It is safest
|
||||
to attach them to the start of each source file to most effectively
|
||||
convey the exclusion of warranty; and each file should have at least
|
||||
the "copyright" line and a pointer to where the full notice is found.
|
||||
|
||||
<one line to give the program's name and a brief idea of what it does.>
|
||||
Copyright (C) <year> <name of author>
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
If the program is interactive, make it output a short notice like this
|
||||
when it starts in an interactive mode:
|
||||
|
||||
Gnomovision version 69, Copyright (C) year name of author
|
||||
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||
This is free software, and you are welcome to redistribute it
|
||||
under certain conditions; type `show c' for details.
|
||||
|
||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
||||
parts of the General Public License. Of course, the commands you use may
|
||||
be called something other than `show w' and `show c'; they could even be
|
||||
mouse-clicks or menu items--whatever suits your program.
|
||||
|
||||
You should also get your employer (if you work as a programmer) or your
|
||||
school, if any, to sign a "copyright disclaimer" for the program, if
|
||||
necessary. Here is a sample; alter the names:
|
||||
|
||||
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
|
||||
`Gnomovision' (which makes passes at compilers) written by James Hacker.
|
||||
|
||||
<signature of Ty Coon>, 1 April 1989
|
||||
Ty Coon, President of Vice
|
||||
|
||||
This General Public License does not permit incorporating your program into
|
||||
proprietary programs. If your program is a subroutine library, you may
|
||||
consider it more useful to permit linking proprietary applications with the
|
||||
library. If this is what you want to do, use the GNU Library General
|
||||
Public License instead of this License.
|
5
Ezmlm-Gpg/trunk/Changes
Normal file
5
Ezmlm-Gpg/trunk/Changes
Normal file
|
@ -0,0 +1,5 @@
|
|||
Revision history for Perl extension Mail::Ezmlm::Gpg
|
||||
|
||||
0.01 Mon Mar 27 02:13:19 2006
|
||||
- original version
|
||||
|
783
Ezmlm-Gpg/trunk/Gpg.pm
Normal file
783
Ezmlm-Gpg/trunk/Gpg.pm
Normal file
|
@ -0,0 +1,783 @@
|
|||
# ===========================================================================
|
||||
# Gpg.pm
|
||||
# $Id$
|
||||
#
|
||||
# Object methods for gpg-ezmlm mailing lists
|
||||
#
|
||||
# Copyright (C) 2006, Lars Kruse, All Rights Reserved.
|
||||
# Please send bug reports and comments to devel@sumpfralle.de
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
package Mail::Ezmlm::Gpg;
|
||||
|
||||
use strict;
|
||||
use vars qw($GPG_BIN $VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
use vars qw(@GPG_LIST_OPTIONS);
|
||||
use Carp;
|
||||
use Crypt::GPG;
|
||||
|
||||
$VERSION = '0.1';
|
||||
|
||||
require 5.005;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Mail::Ezmlm::Gpg - Object Methods for encrypted Ezmlm Mailing Lists
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Mail::Ezmlm::Gpg;
|
||||
$list = new Mail::Ezmlm::Gpg(DIRNAME);
|
||||
|
||||
The rest is a bit complicated for a Synopsis, see the description.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Mail::Ezmlm::Gpg is a Perl module that is designed to provide an object
|
||||
interface to encrypted mailing lists based upon gpgpy-ezmlm.
|
||||
See the gpgpy-ezmlm web page (https://systemausfall.org/toolforge/gpgpy-ezmlm/)
|
||||
for a this software.
|
||||
|
||||
=cut
|
||||
|
||||
# == Begin site dependant variables ==
|
||||
$GPG_BIN = '/usr/bin/gpg'; # Autoinserted by Makefile.PL
|
||||
|
||||
|
||||
# == check the gpg path ==
|
||||
$GPG_BIN = '/usr/local/bin/gpg'
|
||||
unless (-e "$GPG_BIN");
|
||||
$GPG_BIN = '/usr/bin/gpg'
|
||||
unless (-e "$GPG_BIN");
|
||||
$GPG_BIN = '/bin/gpg'
|
||||
unless (-e "$GPG_BIN");
|
||||
$GPG_BIN = '/usr/local/bin/gpg2'
|
||||
unless (-e "$GPG_BIN");
|
||||
$GPG_BIN = '/usr/bin/gpg2'
|
||||
unless (-e "$GPG_BIN");
|
||||
$GPG_BIN = '/bin/gpg2'
|
||||
unless (-e "$GPG_BIN");
|
||||
$GPG_BIN = '/usr/local/bin/gpg'
|
||||
unless (-e "$GPG_BIN");
|
||||
$GPG_BIN = '/bin/gpg'
|
||||
unless (-e "$GPG_BIN");
|
||||
|
||||
# == clean up the path for taint checking ==
|
||||
local $ENV{'PATH'} = "/bin";
|
||||
|
||||
# == define the available (supported) GPG_LIST_OPTIONS ==
|
||||
my %GPGPY_DEFAULT_OPTIONS = (
|
||||
"plain_without_key" => 0,
|
||||
"sign_messages" => 0,
|
||||
"gnupg_dir" => ".gnupg" );
|
||||
|
||||
my $GPGPY_CONF_FILE = 'conf-gpgpy';
|
||||
|
||||
# == Initialiser - Returns a reference to the object ==
|
||||
|
||||
=head2 Setting up a new Ezmlm::Gpg object:
|
||||
|
||||
use Mail::Ezmlm::Gpg;
|
||||
$list = new Mail::Ezmlm::Gpg('/home/user/lists/moolist');
|
||||
|
||||
new() returns the value of thislist() for success, undefined if there was a
|
||||
problem.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my($class, $list) = @_;
|
||||
my $self = {};
|
||||
bless $self, ref $class || $class || 'Mail::Ezmlm::Gpg';
|
||||
$list =~ m/^([\w\._\/-]*)$/;
|
||||
$list = $1;
|
||||
$self->setlist($list) if(defined($list) && $list);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# == convert an existing list to gpg-ezmlm ==
|
||||
|
||||
=head2 Converting a plaintext mailing list to an encrypted list:
|
||||
|
||||
You have to create a normal list before you can convert it.
|
||||
Use Mail::Ezmlm to do this.
|
||||
|
||||
$list->enable_encryption();
|
||||
|
||||
=cut
|
||||
|
||||
sub enable_encryption {
|
||||
my($self) = @_;
|
||||
my $errorstring;
|
||||
|
||||
my $list_dir = $self->{'LIST_NAME'};
|
||||
|
||||
unless (defined($list_dir)) {
|
||||
$errorstring = 'must define directory in enable_encrypted()';
|
||||
$self->_seterror(-1, $errorstring);
|
||||
warn $errorstring;
|
||||
return (1==0);
|
||||
}
|
||||
|
||||
unless(-d $list_dir) {
|
||||
$errorstring = 'directory does not exist: ' . $list_dir;
|
||||
$self->_seterror(-1, $errorstring);
|
||||
warn $errorstring;
|
||||
return (1==0);
|
||||
}
|
||||
|
||||
if ($self->is_encrypted()) {
|
||||
$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);
|
||||
return (0==0);
|
||||
}
|
||||
|
||||
# == convert an encrypted list back to plaintext ==
|
||||
|
||||
=head2 Converting an encryted mailing list to a plaintext list:
|
||||
|
||||
$list->disable_encryption();
|
||||
|
||||
=cut
|
||||
|
||||
sub disable_encryption {
|
||||
my($self) = @_;
|
||||
my $errorstring;
|
||||
|
||||
my $list_dir = $self->{'LIST_NAME'};
|
||||
|
||||
unless (defined($list_dir)) {
|
||||
$errorstring = 'must define directory in disable_encrypted()';
|
||||
$self->_seterror(-1, $errorstring);
|
||||
warn $errorstring;
|
||||
return (1==0);
|
||||
}
|
||||
|
||||
unless(-d $list_dir) {
|
||||
$errorstring = 'directory does not exist: ' . $list_dir;
|
||||
$self->_seterror(-1, $errorstring);
|
||||
warn $errorstring;
|
||||
return (1==0);
|
||||
}
|
||||
|
||||
unless ($self->is_encrypted()) {
|
||||
$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);
|
||||
return (0==0);
|
||||
}
|
||||
|
||||
# == Update the current list ==
|
||||
|
||||
=head2 Updating the configuration of the current list:
|
||||
|
||||
$list->update({ 'allowKeySubmission' => 1 });
|
||||
|
||||
=cut
|
||||
|
||||
sub update {
|
||||
my($self, %switches) = @_;
|
||||
my %ok_switches;
|
||||
my ($one_key, $ok_key, $errorstring);
|
||||
|
||||
# check for important files: 'conf-gpgpy'
|
||||
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
|
||||
# btw we change the case (upper/lower) of the setting to the default one
|
||||
foreach $one_key (keys %switches) {
|
||||
foreach $ok_key (keys %GPGPY_DEFAULT_OPTIONS) {
|
||||
if ($ok_key =~ /^$one_key$/i) {
|
||||
$ok_switches{$ok_key} = $switches{$one_key};
|
||||
delete $switches{$one_key};
|
||||
}
|
||||
}
|
||||
}
|
||||
# %switches should be empty now
|
||||
if (%switches) {
|
||||
foreach $one_key (keys %switches) {
|
||||
warn "unsupported setting: $one_key";
|
||||
}
|
||||
}
|
||||
|
||||
my $config_file_old = "$self->{'LIST_NAME'}/$GPGPY_CONF_FILE";
|
||||
my $config_file_new = "$self->{'LIST_NAME'}/$GPGPY_CONF_FILE.new";
|
||||
if(open(CONFIG_OLD, "<$config_file_old")) {
|
||||
if(open(CONFIG_NEW, ">$config_file_new")) {
|
||||
my ($in_line, $one_opt, $one_val, $new_setting);
|
||||
while (<CONFIG_OLD>) {
|
||||
$in_line = $_;
|
||||
if (%ok_switches) {
|
||||
my $found = 0;
|
||||
while (($one_opt, $one_val) = each(%ok_switches)) {
|
||||
# is this the right line (maybe commented out)?
|
||||
if ($in_line =~ m/^#?\w*$one_opt/i) {
|
||||
print CONFIG_NEW "$one_opt = ";
|
||||
if ($one_opt eq "gnupg_dir") {
|
||||
print CONFIG_NEW $one_val;
|
||||
} else {
|
||||
print CONFIG_NEW ($one_val)? "yes" : "no";
|
||||
}
|
||||
print CONFIG_NEW "\n";
|
||||
delete $ok_switches{$one_opt};
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
print CONFIG_NEW $in_line if ($found == 0);
|
||||
} else {
|
||||
# just print the remaining config file if no other settings are left
|
||||
print CONFIG_NEW $in_line;
|
||||
}
|
||||
}
|
||||
# write the remaining settings to the end of the file
|
||||
while (($one_opt, $one_val) = each(%ok_switches)) {
|
||||
print CONFIG_NEW "\n$one_opt = ";
|
||||
# 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";
|
||||
}
|
||||
} else {
|
||||
$errorstring = "failed to write to temporary config file: $config_file_new";
|
||||
$self->_seterror(-1, $errorstring);
|
||||
warn $errorstring;
|
||||
close CONFIG_OLD;
|
||||
return (1==0);
|
||||
}
|
||||
close CONFIG_NEW;
|
||||
} else {
|
||||
$errorstring = "failed to read the config file: $config_file_old";
|
||||
$self->_seterror(-1, $errorstring);
|
||||
warn $errorstring;
|
||||
return (1==0);
|
||||
}
|
||||
|
||||
close CONFIG_OLD;
|
||||
unless (rename($config_file_new, $config_file_old)) {
|
||||
$errorstring = "failed to move new config file ($config_file_new) "
|
||||
. "to original config file ($config_file_old)";
|
||||
$self->_seterror(-1, $errorstring);
|
||||
warn $errorstring;
|
||||
return (1==0);
|
||||
}
|
||||
|
||||
$self->_seterror(undef);
|
||||
return (0==0);
|
||||
}
|
||||
|
||||
|
||||
# == Get a list of options for the current list ==
|
||||
|
||||
=head2 Getting the current configuration of the current list:
|
||||
|
||||
$list->getconfig;
|
||||
|
||||
getconfig() returns a hash including all available settings
|
||||
(undefined settings are returned with their default value).
|
||||
|
||||
=cut
|
||||
|
||||
sub getconfig {
|
||||
my($self) = @_;
|
||||
my(%options, $key);
|
||||
|
||||
foreach $key (keys %GPGPY_DEFAULT_OPTIONS) {
|
||||
$options{$key} = $GPGPY_DEFAULT_OPTIONS{$key};
|
||||
}
|
||||
|
||||
# Read the config file
|
||||
if(open(CONFIG, "<$self->{'LIST_NAME'}/$GPGPY_CONF_FILE")) {
|
||||
# 'conf-gpgpy' contains the authorative information
|
||||
while(<CONFIG>) {
|
||||
if (/^(\w+)\s*=\s*(.*)$/) {
|
||||
my $optname = $1;
|
||||
my $optvalue = $2;
|
||||
my $one_opt;
|
||||
foreach $one_opt (keys %GPGPY_DEFAULT_OPTIONS) {
|
||||
if ($one_opt =~ m/^$optname$/i) {
|
||||
if ($optname ne 'gnupg_dir') {
|
||||
# 'gnupg_dir' is the only non-boolean setting
|
||||
if ($optvalue =~ /^yes$/i) {
|
||||
$options{$one_opt} = 1;
|
||||
} else {
|
||||
$options{$one_opt} = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
close CONFIG;
|
||||
} else {
|
||||
$self->_seterror(-1, 'unable to read configuration file in getconfig()' && return undef);
|
||||
}
|
||||
|
||||
$self->_seterror(undef);
|
||||
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 ==
|
||||
|
||||
=head2 Determining which list we are currently altering:
|
||||
|
||||
$whichlist = $list->thislist;
|
||||
print $list->thislist;
|
||||
|
||||
=cut
|
||||
|
||||
sub thislist {
|
||||
my($self) = shift;
|
||||
$self->_seterror(undef);
|
||||
return $self->{'LIST_NAME'};
|
||||
}
|
||||
|
||||
|
||||
# == Set the current mailing list ==
|
||||
|
||||
=head2 Changing which list the Mail::Ezmlm::Gpg object points at:
|
||||
|
||||
$list->setlist('/home/user/lists/moolist');
|
||||
|
||||
=cut
|
||||
|
||||
sub setlist {
|
||||
my($self, $list) = @_;
|
||||
if ($list =~ m/^([\w\d\_\-\.\/]+)$/) {
|
||||
$list = $1;
|
||||
if (-e "$list/lock") {
|
||||
# it is an ezmlm list
|
||||
# it is not necessary, that it is an encrypted list
|
||||
$self->_seterror(undef);
|
||||
return $self->{'LIST_NAME'} = $list;
|
||||
} else {
|
||||
# not an ezmlm list
|
||||
$self->_seterror(-1, "$list does not appear to be a valid list in setlist()");
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
# invalid characters
|
||||
$self->_seterror(-1, "$list contains tainted data in setlist()");
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# == is the list encrypted? ==
|
||||
|
||||
=head2 Checking the state of a list:
|
||||
|
||||
To determine, if a list is encrypted or not, call is_encrypted().
|
||||
|
||||
$list->is_encrypted();
|
||||
|
||||
=cut
|
||||
|
||||
sub is_encrypted {
|
||||
my($self) = @_;
|
||||
($self->_seterror(-1, 'must setlist() before is_encrypted()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||
$self->_seterror(undef);
|
||||
if (-e "$self->{'LIST_NAME'}/$GPGPY_CONF_FILE") {
|
||||
return (0==0);
|
||||
} else {
|
||||
return (1==0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# == export a key ==
|
||||
|
||||
=head2 Export a key:
|
||||
|
||||
You may export public keys of the keyring of a list.
|
||||
|
||||
The key can be identified by its id or other (unique) patterns (like the
|
||||
gnupg program).
|
||||
|
||||
$list->export_key($key_id);
|
||||
$list->export_key($email_address);
|
||||
|
||||
The return value is a string containing the ascii armored key data.
|
||||
|
||||
=cut
|
||||
|
||||
sub export_key {
|
||||
my ($self, $keyid) = @_;
|
||||
my $gpg = $self->_get_gpg_object();
|
||||
my $gpgoption = "--armor --export $keyid";
|
||||
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " $gpgoption";
|
||||
my $output = `$gpgcommand 2>/dev/null`;
|
||||
if ($output) {
|
||||
return $output;
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# == import a new key ==
|
||||
|
||||
=head2 Import a key:
|
||||
|
||||
You can import public or secret keys into the keyring of the list.
|
||||
|
||||
The key should be ascii armored.
|
||||
|
||||
$list->import_key($ascii_armored_key_date);
|
||||
|
||||
=cut
|
||||
|
||||
sub import_key {
|
||||
my ($self, $key) = @_;
|
||||
my $gpg = $self->_get_gpg_object();
|
||||
if ($gpg->addkey($key)) {
|
||||
return (0==0);
|
||||
} else {
|
||||
return (1==0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# == delete a key ==
|
||||
|
||||
=head2 Delete a key:
|
||||
|
||||
Remove a public key (and the matching secret key if it exists) from the keyring
|
||||
of the list.
|
||||
|
||||
The argument is the id of the key or any other unique pattern.
|
||||
|
||||
$list->delete_key($keyid);
|
||||
|
||||
=cut
|
||||
|
||||
sub delete_key {
|
||||
my ($self, $keyid) = @_;
|
||||
my $gpg = $self->_get_gpg_object();
|
||||
my $fprint = $self->_get_fingerprint($keyid);
|
||||
return (1==0) unless (defined($fprint));
|
||||
my $gpgoption = "--delete-secret-and-public-key $fprint";
|
||||
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " $gpgoption";
|
||||
if (system($gpgcommand)) {
|
||||
return (1==0);
|
||||
} else {
|
||||
return (0==0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# == generate new private key ==
|
||||
|
||||
=head2 Generate a new key:
|
||||
|
||||
$list->generate_key($name, $comment, $email_address, $keysize, $expire);
|
||||
|
||||
Refer to the documentation of gnupg for the format of the arguments.
|
||||
|
||||
=cut
|
||||
|
||||
sub generate_private_key {
|
||||
my ($self, $name, $comment, $email, $keysize, $expire) = @_;
|
||||
my $gpg = $self->_get_gpg_object();
|
||||
my $gpgoption = "--gen-key";
|
||||
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " $gpgoption";
|
||||
my $pid = open(INPUT, "| $gpgcommand");
|
||||
print INPUT "Key-Type: DSA\n";
|
||||
print INPUT "Key-Length: 1024\n";
|
||||
print INPUT "Subkey-Type: ELG-E\n";
|
||||
print INPUT "Subkey-Length: $keysize\n";
|
||||
print INPUT "Name-Real: $name\n";
|
||||
print INPUT "Name-Comment: $comment\n" if ($comment);
|
||||
print INPUT "Name-Email: $email\n";
|
||||
print INPUT "Expire-Date: $expire\n";
|
||||
return close INPUT;
|
||||
}
|
||||
|
||||
|
||||
# == get_public_keys ==
|
||||
|
||||
=head2 Getting public keys:
|
||||
|
||||
Return an array of key hashes each containing the following elements:
|
||||
|
||||
=over
|
||||
|
||||
=item *
|
||||
name
|
||||
|
||||
=item *
|
||||
email
|
||||
|
||||
=item *
|
||||
id
|
||||
|
||||
=item *
|
||||
expires
|
||||
|
||||
=back
|
||||
|
||||
$list->get_public_keys();
|
||||
$list->get_secret_keys();
|
||||
|
||||
=cut
|
||||
|
||||
sub get_public_keys {
|
||||
my ($self) = @_;
|
||||
my @keys = $self->_get_keys("pub");
|
||||
return @keys;
|
||||
}
|
||||
|
||||
|
||||
# == get_private_keys ==
|
||||
# see above for POD (get_public_keys)
|
||||
sub get_secret_keys {
|
||||
my ($self) = @_;
|
||||
my @keys = $self->_get_keys("sec");
|
||||
return @keys;
|
||||
}
|
||||
|
||||
|
||||
############ some internal functions ##############
|
||||
|
||||
# == internal function for creating a gpg object ==
|
||||
sub _get_gpg_object() {
|
||||
my ($self) = @_;
|
||||
my $gpg = new Crypt::GPG();
|
||||
my $dirname = $self->get_gnupg_dir();
|
||||
# fix spaces in filename
|
||||
$dirname =~ s/ /\\ /g;
|
||||
$gpg->gpgbin($GPG_BIN);
|
||||
$gpg->gpgopts("--lock-multiple --no-tty --no-secmem-warning --batch --quiet --homedir $dirname");
|
||||
return $gpg;
|
||||
}
|
||||
|
||||
|
||||
# == internal function to list keys ==
|
||||
sub _get_keys() {
|
||||
# type can be "pub" or "sec"
|
||||
my ($self, $keyType) = @_;
|
||||
my $gpg = $self->_get_gpg_object();
|
||||
my ($flag, $gpgoption, @keys, $key);
|
||||
if ($keyType eq "pub") {
|
||||
$flag = "pub";
|
||||
$gpgoption = "--list-keys";
|
||||
} elsif ($keyType eq "sec") {
|
||||
$flag = "sec";
|
||||
$gpgoption = "--list-secret-keys";
|
||||
} else {
|
||||
warn "wrong keyType: $keyType";
|
||||
return undef;
|
||||
}
|
||||
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " --with-colons $gpgoption";
|
||||
my @read_keys = grep /^$flag/, `$gpgcommand`;
|
||||
foreach $key (@read_keys) {
|
||||
my ($type, $trust, $size, $algorithm, $id, $created,
|
||||
$expires, $u2, $ownertrust, $uid) = split ":", $key;
|
||||
# stupid way of "decoding" utf8 (at least it works for ":")
|
||||
$uid =~ s/\\x3a/:/g;
|
||||
$uid =~ /^(.*) <([^<]*)>/;
|
||||
my $name = $1;
|
||||
my $email = $2;
|
||||
push @keys, {name => $name, email => $email, id => $id, expires => $expires};
|
||||
}
|
||||
return @keys;
|
||||
}
|
||||
|
||||
|
||||
# == internal function to retrieve the fingerprint of a key ==
|
||||
sub _get_fingerprint()
|
||||
{
|
||||
my ($self, $key_id) = @_;
|
||||
my $gpg = $self->_get_gpg_object();
|
||||
$key_id =~ /^([0-9A-Z]*)$/;
|
||||
$key_id = $1;
|
||||
return undef unless ($key_id);
|
||||
my $gpgoption = "--fingerprint $key_id";
|
||||
|
||||
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " --with-colons $gpgoption";
|
||||
|
||||
my @fingerprints = grep /^fpr:/, `$gpgcommand`;
|
||||
if (@fingerprints > 1) {
|
||||
warn "[Mail::Ezmlm::Gpg] more than one key matched ($key_id)!";
|
||||
return undef;
|
||||
}
|
||||
return undef if (@fingerprints < 1);
|
||||
my $fpr = $fingerprints[0];
|
||||
$fpr =~ /^fpr:*([0-9A-Z]*):*$/;
|
||||
$fpr = $1;
|
||||
return undef unless $1;
|
||||
return $1;
|
||||
}
|
||||
|
||||
|
||||
# == return an error message if appropriate ==
|
||||
sub errmsg {
|
||||
my($self) = @_;
|
||||
return $self->{'ERRMSG'};
|
||||
}
|
||||
|
||||
sub errno {
|
||||
my($self) = @_;
|
||||
return $self->{'ERRNO'};
|
||||
}
|
||||
|
||||
|
||||
# == Internal function to set the error to return ==
|
||||
sub _seterror {
|
||||
my($self, $no, $mesg) = @_;
|
||||
|
||||
if(defined($no) && $no) {
|
||||
if($no < 0) {
|
||||
$self->{'ERRNO'} = -1;
|
||||
$self->{'ERRMSG'} = $mesg || 'An undefined error occoured';
|
||||
} else {
|
||||
$self->{'ERRNO'} = $no / 256;
|
||||
$self->{'ERRMSG'} = $! || $mesg || 'An undefined error occoured in a system() call';
|
||||
}
|
||||
} else {
|
||||
$self->{'ERRNO'} = 0;
|
||||
$self->{'ERRMSG'} = undef;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
# == Internal function to test for valid email addresses ==
|
||||
sub _checkaddress {
|
||||
my($self, $address) = @_;
|
||||
return 1 unless defined($address);
|
||||
return 0 unless ($address =~ m/^(\S+\@\S+\.\S+)$/);
|
||||
$_[1] = $1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
=head1 RETURN VALUES
|
||||
|
||||
All of the routines described above have return values. 0 or undefined are
|
||||
used to indicate that an error of some form has occoured, while anything
|
||||
>0 (including strings, etc) are used to indicate success.
|
||||
|
||||
If an error is encountered, the functions
|
||||
|
||||
$list->errno();
|
||||
$list->errmsg();
|
||||
|
||||
can be used to determine what the error was.
|
||||
|
||||
errno() returns; 0 or undef if there was no error.
|
||||
-1 for an error relating to this module.
|
||||
>0 exit value of the last system() call.
|
||||
|
||||
errmsg() returns a string containing a description of the error ($! if it
|
||||
was from a system() call). If there is no error, it returns undef.
|
||||
|
||||
For those who are interested, in those sub routines that have to make system
|
||||
calls to perform their function, an undefined value indicates that the
|
||||
system call failed, while 0 indicates some other error. Things that you would
|
||||
expect to return a string (such as thislist()) return undefined to indicate
|
||||
that they haven't a clue ... as opposed to the empty string which would mean
|
||||
that they know about nothing :)
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Lars Kruse <devel@sumpfralle.de>
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
There are no known bugs.
|
||||
|
||||
Please report bugs to the author or use the bug tracking system at
|
||||
https://systemausfall.org/trac/ezmlm-web.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
ezmlm(5), ezmlm-make(2), ezmlm-sub(1),
|
||||
ezmlm-unsub(1), ezmlm-list(1), ezmlm-issub(1)
|
||||
|
||||
https://systemausfall.org/toolforge/ezmlm-web/
|
||||
http://www.synacklabs.net/projects/crypt-ml/
|
||||
http://www.ezmlm.org/
|
||||
http://www.qmail.org/
|
||||
|
||||
=cut
|
8
Ezmlm-Gpg/trunk/MANIFEST
Normal file
8
Ezmlm-Gpg/trunk/MANIFEST
Normal file
|
@ -0,0 +1,8 @@
|
|||
Changes
|
||||
Gpg.pm
|
||||
MANIFEST
|
||||
README
|
||||
Makefile.PL
|
||||
test.pl
|
||||
COPYING
|
||||
META.yml
|
11
Ezmlm-Gpg/trunk/META.yml
Normal file
11
Ezmlm-Gpg/trunk/META.yml
Normal file
|
@ -0,0 +1,11 @@
|
|||
# http://module-build.sourceforge.net/META-spec.html
|
||||
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
|
||||
name: Mail-Ezmlm-Gpg
|
||||
version: 0.1
|
||||
version_from: Gpg.pm
|
||||
installdirs: site
|
||||
requires:
|
||||
Mail::Ezmlm: 0.05
|
||||
|
||||
distribution_type: module
|
||||
generated_by: ExtUtils::MakeMaker version 6.17
|
111
Ezmlm-Gpg/trunk/Makefile.PL
Normal file
111
Ezmlm-Gpg/trunk/Makefile.PL
Normal file
|
@ -0,0 +1,111 @@
|
|||
# $Id$
|
||||
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
'CONFIGURE' => \&set_paths,
|
||||
'NAME' => 'Mail::Ezmlm::Gpg',
|
||||
'VERSION_FROM' => 'Gpg.pm', # finds $VERSION
|
||||
'DISTNAME' => 'Mail-Ezmlm-Gpg',
|
||||
'PREREQ_PM' => { 'Mail::Ezmlm' => 0.05 },
|
||||
'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' },
|
||||
'clean' => { FILES => 'gpg-ezmlmtmp' }
|
||||
);
|
||||
|
||||
use strict;
|
||||
|
||||
sub set_paths {
|
||||
my ($gpg_path, $GPG_EZMLM_BASE);
|
||||
|
||||
# special case to handle the FreeBSD ports system
|
||||
if ($ENV{BSD_BATCH_INSTALL}) {
|
||||
print STDERR "\$BSD_BATCH_INSTALL is set in your environment, assuming port defaults\n";
|
||||
return {};
|
||||
}
|
||||
|
||||
print "\nTo work correctly, I need to know, where your gnupg program is located.\n\n";
|
||||
|
||||
*prompt = \&ExtUtils::MakeMaker::prompt;
|
||||
|
||||
# guess default
|
||||
$gpg_path = '/usr/local/bin/gpg'
|
||||
unless (-e "$gpg_path");
|
||||
$gpg_path = '/usr/bin/gpg'
|
||||
unless (-e "$gpg_path");
|
||||
$gpg_path = '/bin/gpg'
|
||||
unless (-e "$gpg_path");
|
||||
$gpg_path = '/usr/local/bin/gpg2'
|
||||
unless (-e "$gpg_path");
|
||||
$gpg_path = '/usr/bin/gpg2'
|
||||
unless (-e "$gpg_path");
|
||||
$gpg_path = '/bin/gpg2'
|
||||
unless (-e "$gpg_path");
|
||||
# return to default, if nothing can be found
|
||||
$gpg_path = '/usr/bin/gpg'
|
||||
unless (-e "$gpg_path");
|
||||
|
||||
foreach (1..10) {
|
||||
$gpg_path = prompt('Location of your gnupg program?', "$gpg_path");
|
||||
last if (-e "$gpg_path");
|
||||
print "I can't find '$gpg_path'. Please try again\n";
|
||||
}
|
||||
unless (-e "$gpg_path") {
|
||||
$gpg_path = '/usr/bin';
|
||||
print STDERR "Warning: No correct input after 10 attempts. Using default ($gpg_path) ...\n";
|
||||
}
|
||||
|
||||
|
||||
print "\n\nI also need to know, where to find your gpg-ezmlm binaries.\n\n";
|
||||
# guess the location of the gpg-ezmlm program files
|
||||
$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");
|
||||
|
||||
foreach (1..10) {
|
||||
$GPG_EZMLM_BASE = prompt('Location of your gpg-ezmlm binaries?', "$GPG_EZMLM_BASE");
|
||||
last if (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
|
||||
print "I can't find '$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl'. Please try again\n";
|
||||
}
|
||||
unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl") {
|
||||
$GPG_EZMLM_BASE = '/usr/bin';
|
||||
print STDERR "Warning: No correct input after 10 attempts. Using default ($GPG_EZMLM_BASE) ...\n";
|
||||
}
|
||||
|
||||
|
||||
print << 'EOM';
|
||||
|
||||
Thank you. I will use this information to configure Mail::Ezmlm::Gpg for you
|
||||
|
||||
EOM
|
||||
|
||||
# Back up file
|
||||
open(GPG, '<Gpg.pm') or die "Unable to open Gpg.pm for read: $!";
|
||||
open(TMP, ">Gpg.pm.tmp.$$") or die "Unable to create temp file: $!";
|
||||
while(<GPG>) { print TMP; }
|
||||
close TMP; close GPG;
|
||||
|
||||
# Do variable substitution
|
||||
open(GPG, '>Gpg.pm') or die "Unable to open Gpg.pm for write: $!";
|
||||
open(TMP, "<Gpg.pm.tmp.$$") or die "Unable to read temp file: $!";
|
||||
while(<TMP>) {
|
||||
s{^\$GPG_BIN\s*=\s*['"].+?['"]\s*;\s*(#.*|)$}{\$GPG_BIN = '$gpg_path'; # Autoinserted by Makefile.PL};
|
||||
s{^\$GPG_EZMLM_BASE\s*=\s*['"].+?['"]\s*;\s*(#.*|)$}{\$GPG_EZMLM_BASE = '$GPG_EZMLM_BASE'; # Autoinserted by Makefile.PL};
|
||||
print GPG;
|
||||
}
|
||||
close TMP; close GPG;
|
||||
|
||||
unlink "Gpg.pm.tmp.$$";
|
||||
|
||||
return {};
|
||||
|
||||
}
|
16
Ezmlm-Gpg/trunk/README
Normal file
16
Ezmlm-Gpg/trunk/README
Normal file
|
@ -0,0 +1,16 @@
|
|||
Mail::Ezmlm:Gpg
|
||||
|
||||
Object methods for gpg-ezmlm mailing lists
|
||||
(see http://www.synacklabs.net/projects/crypt-ml)
|
||||
|
||||
Install by doing the following ...
|
||||
# perl Makefile.PL
|
||||
# make test
|
||||
# make install
|
||||
|
||||
One thing. For some reason MakeMaker doesn't like symlinks. Please make sure
|
||||
you use the full cantonical path for the gnupg and gpg-ezmlm binaries.
|
||||
|
||||
Read the documentation by running "man Mail::Ezmlm::Gpg".
|
||||
|
||||
- Lars Kruse <devel@sumpfralle.de>
|
107
Ezmlm-Gpg/trunk/test.pl
Normal file
107
Ezmlm-Gpg/trunk/test.pl
Normal file
|
@ -0,0 +1,107 @@
|
|||
# ===========================================================================
|
||||
# test.pl - version 0.02 - 25/09/2000
|
||||
# $Id: test.pl,v 1.5 2005/03/05 14:08:30 guy Exp $
|
||||
# Test suite for Mail::Ezmlm
|
||||
#
|
||||
# Copyright (C) 02006, Lars Kruse, All Rights Reserved.
|
||||
# Please send bug reports and comments to devel@sumpfralle.de
|
||||
#
|
||||
# This program is subject to the restrictions set out in the copyright
|
||||
# agreement that can be found in the Gpg.pm file in this distribution
|
||||
#
|
||||
# ==========================================================================
|
||||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl test.pl'
|
||||
|
||||
|
||||
use Test;
|
||||
use strict;
|
||||
|
||||
BEGIN { plan tests => 13 }
|
||||
|
||||
print "Trying to load the Mail::Ezmlm module: ";
|
||||
eval { require Mail::Ezmlm; return 1;};
|
||||
ok($@,'');
|
||||
croak() if $@; # If Mail::Ezmlm didn't load... bail hard now
|
||||
|
||||
print "Trying to load the Mail::Ezmlm::Gpg module: ";
|
||||
eval { require "Gpg.pm"; return 1;};
|
||||
ok($@,'');
|
||||
croak() if $@; # Mail::Ezmlm::Gpg is essential ...
|
||||
|
||||
|
||||
print "Checking version of gpg-ezmlm: ";
|
||||
my $version_check = Mail::Ezmlm::Gpg->check_gpg_ezmlm_version();
|
||||
ok($version_check);
|
||||
croak() unless ($version_check); # the version of gpg-ezmlm is important
|
||||
|
||||
use Cwd;
|
||||
my $list = new Mail::Ezmlm;
|
||||
|
||||
# create a temp directory if necessary
|
||||
my $TMP = cwd() . '/gpg-ezmlmtmp';
|
||||
mkdir $TMP, 0755 unless (-d $TMP);
|
||||
|
||||
print 'Checking list creation with Mail::Ezmlm: ';
|
||||
my $test1 = $list->make(-name=>"ezmlm-test1-$$",
|
||||
-qmail=>"$TMP/.qmail-ezmlm-test1-$$",
|
||||
-dir=>"$TMP/ezmlm-test1-$$");
|
||||
|
||||
ok($test1 eq "$TMP/ezmlm-test1-$$");
|
||||
|
||||
# backup the created to list to check clean conversion later
|
||||
system("cp", "-a", $list->{'LIST_NAME'}, $list->{'LIST_NAME'} . ".backup");
|
||||
|
||||
|
||||
print 'Testing list conversion from plaintext to encryption: ';
|
||||
my $gpg_list = new Mail::Ezmlm::Gpg($list->{'LIST_NAME'});
|
||||
ok($gpg_list->convert_to_encrypted() && $gpg_list->is_gpg());
|
||||
|
||||
|
||||
print 'Testing list conversion from encryption to plaintext: ';
|
||||
ok($gpg_list->convert_to_plaintext() && !($gpg_list->is_gpg()));
|
||||
|
||||
|
||||
print 'Testing if back and forth conversion was clean: ';
|
||||
ok(system("diff -qr --exclude=.gnupg --exclude=tmp --exclude=text '" . $list->{'LIST_NAME'} . "' '" . $list->{'LIST_NAME'} . '.backup' . "' 2>/dev/null") == 0);
|
||||
|
||||
|
||||
print 'Testing getconfig: ';
|
||||
$gpg_list->convert_to_encrypted();
|
||||
ok($gpg_list->getconfig());
|
||||
|
||||
|
||||
print 'Testing update: ';
|
||||
# toggle a setting and check, if it works
|
||||
$gpg_list->update((requireSigs => 1));
|
||||
my %list_config = $gpg_list->getconfig();
|
||||
my $update_failed = ($list_config{requireSigs} == 1)? 0 : 1;
|
||||
unless ($update_failed) {
|
||||
$gpg_list->update((requireSigs => 0));
|
||||
%list_config = $gpg_list->getconfig();
|
||||
$update_failed = ($list_config{requireSigs} == 0)? 0 : 1;
|
||||
}
|
||||
ok(!$update_failed);
|
||||
|
||||
|
||||
print 'Testing key generation: ';
|
||||
ok($gpg_list->generate_private_key('Name', 'Comment', 'mail@addr.ess', 1024, 0));
|
||||
|
||||
|
||||
print 'Testing key retrieval: ';
|
||||
my @pub_keys = $gpg_list->get_public_keys();
|
||||
my @sec_keys = $gpg_list->get_secret_keys();
|
||||
ok((@pub_keys == 1) && (@sec_keys == 1));
|
||||
|
||||
|
||||
print 'Testing key export: ';
|
||||
my $keyid = $pub_keys[0]{id};
|
||||
ok($keyid && $gpg_list->export_key($keyid));
|
||||
|
||||
|
||||
print 'Testing key deletion: ';
|
||||
$gpg_list->delete_key($keyid);
|
||||
@pub_keys = $gpg_list->get_public_keys();
|
||||
@sec_keys = $gpg_list->get_secret_keys();
|
||||
ok((@pub_keys == 0) && (@sec_keys == 0));
|
||||
|
Loading…
Add table
Add a link
Reference in a new issue