@@ -1,11 +1,75 @@
________________________________________________________________________________
- Filter::Crypto, Version 2.03
+ Filter::Crypto, Version 2.06
________________________________________________________________________________
Revision history for Perl extension Filter::Crypto.
_________________
+v2.06 30 May 2014
+
+ - Simplified repository metadata for cleaner appearance on search.cpan.org.
+_________________
+
+v2.05 16 May 2014
+
+ - Avoided possible test failures in t/02_function.t, t/03_script.t and
+ t/04_par.t by avoiding the problem of trying to open a file with a pending
+ delete.
+
+ - Reduced memory fragmentation when running encrypted Perl scripts. (Fixes
+ [cpan #95021]. Thanks to Kevin Groeneveld <kgroeneveld@gmail.com> for the
+ patch.)
+
+ - Removed the rudimentary checks on the compiler versions in Makefile.PL
+ when building these modules on Windows since it appears that using
+ different compilers (and hence potentially different C RTL DLLs) is safe
+ after all. Note, however, that there is still a compatibility problem
+ when building this module with Visual Studio .NET 2002/2003 (VC7) or
+ earlier if your perl was built with Visual Studio 2005 (VC8) or later: see
+ [perl #121448]. However, that is quite an unlikely scenario, so it is not
+ worth checking for in Makefile.PL.
+
+ - Changed all PerlLIO_*() function calls to the corresponding lowio
+ functions: they should be redefined as necessary by perl's header files
+ anyway, which is indeed the case in perl-5.8.1 and above, at least -- see
+ the exchanges between myself and Jan Dubois on the "perl5-porters" mailing
+ list, 04-05 Mar 2010, for more details on this.
+
+ - Uploaded source code to GitHub and included repository URLs in metadata.
+
+ - Included META.json file in addition to META.yml.
+
+ - Simplified Makefile.PL commands for making a new distribution archive.
+
+ - Bumped minimum required ExtUtils::MakeMaker version to 6.66 to allow
+ building with 64-bit perl (otherwise the build fails with errors about
+ fakethr.h and perlsfio.h).
+
+ - Reverted to plain old ExtUtils::MakeMaker for building, now that that's
+ more fully maintained again. Module::Install has virtually died a death,
+ and Module::Build is no better either. Require a fairly recent version
+ (6.64) to ensure that all parameters used are supported, to save jumping
+ through hoops to support earlier versions. (This should not be a problem
+ since ExtUtils::MakeMaker 6.64 is easily installed into Perl 5.8.1 and
+ above, that being the whole point of the new choice of minimum supported
+ Perl version.)
+
+ - Set minimum required OpenSSL version to 0.9.6k or 0.9.7c, which are
+ approximately contemporaneous with Perl 5.8.1.
+
+ - Bumped minimum required Perl version from 5.6.0 to 5.8.1. This is in line
+ with the minimum requirement of the "Perl Toolchain".
+_________________
+
+v2.04 19 Feb 2014
+
+ - Fixed crypt_file's "-c encrypted" and "-c decrypted" options when used in
+ conjunction with the "-e tempfile" option. These combinations of options
+ previously caused the input file to be replaced with a zero length file.
+ (Fixes [cpan #93152].)
+_________________
+
v2.03 08 Jul 2013
- Improved crypto library detection so that the library is now correctly
@@ -20,8 +84,8 @@ v2.02 14 Feb 2013
- Removed an sscanf() accidentally left behind after the previous change.
It should have been removed, and its accidental retention could have been
- the cause of a CPAN Testers "FAIL" report involving a core dump since it
- actually caused a buffer overrun.
+ the cause of a CPAN Testers Reports "FAIL" report involving a core dump
+ since it actually caused a buffer overrun.
_________________
v2.01 07 Feb 2013
@@ -44,7 +108,7 @@ v1.36 20 Mar 2012
- Removed extra diagnostics previously added to t/03_script.t now that the
cause of the "FAIL" reports has been discovered. It turns out that the
- perl installations in question are all development versions of perl (5.X.Y
+ perl installations in question are all development versions of Perl (5.X.Y
where X is an odd number) with $Config{versiononly} defined and the
required "perldoc" script consequently named "perldoc5.X.Y" rather than
the usual "perldoc".
@@ -63,7 +127,7 @@ _________________
v1.35 05 Mar 2012
- Added extra diagnostics to t/03_script.t to try to discover the cause of
- persistent CPAN Testers "FAIL" reports regarding test 99.
+ persistent CPAN Testers Reports "FAIL" reports regarding test 99.
_________________
v1.34 02 Mar 2012
@@ -118,7 +182,7 @@ v1.30 14 Nov 2009
- Fixed t/03_script.t to skip test 99 when run on a Debian-based host
without perl-doc installed. (Thanks to C.J. Adams-Collier
- <cjac@colliertech.org> on the Debian perl mailing list
+ <cjac@colliertech.org> on the Debian Perl mailing list
(debian-perl@lists.debian.org) for the patch to fix this.)
- Added a note to LICENCE to mention that whilst this distribution is
@@ -132,9 +196,9 @@ v1.29 26 Oct 2009
- The previous changes to check in new locations and for libcrypto.so as
well as libcrypto.a broke some Solaris 2.10 builds which have a
- libcrypto.so in /opt/csw/lib/amd64 but aren't using a 64-bit Perl. Change
+ libcrypto.so in /opt/csw/lib/amd64 but aren't using a 64-bit perl. Change
the library file detection code to only consider the 64-bit library file
- locations if we are using a 64-bit Perl.
+ locations if we are using a 64-bit perl.
- The previous change to update ppport.h broke builds with Perl >= 5.9.5
because new support for PL_rsfp_filters requires an explicit request for
@@ -143,9 +207,9 @@ _________________
v1.28 25 Oct 2009
- - The previous change to address CPAN Testers "FAIL" reports from Solaris
- 2.11 didn't work, perhaps because, as pointed out on the OpenSSL users
- mailing list (openssl-users@openssl.org), libcrypto.so must be used
+ - The previous change to address CPAN Testers Reports "FAIL" reports from
+ Solaris 2.11 didn't work, perhaps because, as pointed out on the OpenSSL
+ users mailing list (openssl-users@openssl.org), libcrypto.so must be used
instead of libcrypto.a. Therefore, added code to check for libcrypto.so
where libcrypto.a isn't found.
@@ -157,7 +221,7 @@ _________________
v1.27 22 Oct 2009
- Fixed a double-free error in the Decrypt component when using Perl 5.6.2,
- which was detected by some CPAN Testers "FAIL" reports.
+ which was detected by some CPAN Testers Reports "FAIL" reports.
The filter's SV contains a pointer to the filter context. The SV is made
magical so that when the SV is destroyed the filter context gets
@@ -169,7 +233,7 @@ v1.27 22 Oct 2009
true in this case (our mg_len is always 0), hence the errors with Perl
5.6.2. From Perl 5.7.3 onwards (specifically, perl change #14373),
Perl_mg_free() only frees the mg_ptr again if mg_len > 0, so the double-
- free wouldn't occur with those Perls. However, it is good practice to set
+ free wouldn't occur with those perls. However, it is good practice to set
pointers to NULL after freeing them, so this is done in
FilterCrypto_FilterSvMgFree() for all versions of Perl, and all other
pointers elsewhere are also set to NULL after being freed.
@@ -179,14 +243,14 @@ v1.27 22 Oct 2009
library could be found on 64-bit Solaris Intel and 64-bit Solaris Sparc
systems respectively, according to answers from the OpenSSL users mailing
list (openssl-users@openssl.org), and should hopefully resolve a couple of
- CPAN Testers "FAIL" reports from 64-bit Solaris 2.11.
+ CPAN Testers Reports "FAIL" reports from 64-bit Solaris 2.11.
_________________
v1.26 18 Oct 2009
- Declared a minimum version of 1.15 for Pod::Usage. (In the course of
investigating [cpan #50533], which I still haven't resolved as of this
- writing, I found that t/03_script.t fails test 99 when using a Perl build
+ writing, I found that t/03_script.t fails test 99 when using a perl build
with an architecture-dependent lib/ folder if Pod[-]Parser is 1.21 or
older (which contains Pod::Usage 1.14 or older) due to a bug that was
explicitly fixed in PodParser 1.22 (which contains Pod::Usage 1.15).)
@@ -197,12 +261,13 @@ v1.26 18 Oct 2009
$SIG{__WARN__} handler when loading it, rather than by not using blib.
This ensures that the extra work done by blib compared to the simplistic
"perl -Iblib/arch -Iblib/lib ..." approach is not missed, which might have
- some bearing on some of the CPAN Testers' "FAIL" reports (most of which
- relate to a sufficiently old Perl version to have the old blib concerned).
+ some bearing on some of the CPAN Testers Reports "FAIL" reports (most of
+ which relate to a sufficiently old Perl version to have the old blib
+ concerned).
- - Added a check for "debug" mode Perl builds in Makefile.PL when building
- the "Decrypt" component. This should ensure that CPAN Testers report
- "N/A" rather than "UNKNOWN" if their Perl builds are "debug" mode.
+ - Added a check for "debug" mode perl builds in Makefile.PL when building
+ the "Decrypt" component. This should ensure that CPAN Testers Reports
+ report "N/A" rather than "UNKNOWN" if their perl builds are "debug" mode.
_________________
v1.25 11 Oct 2009
@@ -255,15 +320,15 @@ _________________
v1.21 06 Jul 2008
- Added the magic "OS unsupported" phrase to Makefile.PL's die() message so
- that CPAN Testers report "N/A" rather than "FAIL" on OSes where no OpenSSL
- or SSLeay installation has been detected.
+ that CPAN Testers Reports report "N/A" rather than "FAIL" on OSes where no
+ OpenSSL or SSLeay installation has been detected.
- Updated Module::Install::PRIVATE to version 1.06 for Makefile.PL
improvements:
* Added the magic "OS unsupported" phrase to Makefile.PL's die() message
- so that CPAN Testers report "N/A" rather than "FAIL" on OSes where the
- appropriate C compiler cannot be found.
+ so that CPAN Testers Reports report "N/A" rather than "FAIL" on OSes
+ where the appropriate C compiler cannot be found.
- Updated Module::Install components from version 0.75 of that distribution.
Changed Makefile.PL appropriately to cope with a non-backwards-compatible
@@ -312,8 +377,9 @@ v1.19 10 Jul 2007
- Updated Module::Install::PRIVATE to version 1.05 for Makefile.PL
improvements:
- * Fixed the compiler version checking on Win32 for Visual C++ 8.x, which
- now uses four numbers separated by dots for its compiler version.
+ * Fixed the compiler version checking on Win32 for Visual Studio 2005
+ (VC8), which now uses four numbers separated by dots for its compiler
+ version.
- Updated Module::Install components from version 0.65 of that distribution.
@@ -417,8 +483,9 @@ v1.15 02 Sep 2005
improvements:
* Relaxed the compiler version checking so that only the major version
- numbers have to match (and also the minor version numbers for VC++ 7 and
- later, which use CRT DLLs named msvcr70.dll, msvcr71.dll, etc)
+ numbers have to match (and also the minor version numbers for Visual
+ Studio .NET 2002/2003 (VC7) and later, which use C RTL DLLs named
+ msvcr70.dll, msvcr71.dll, etc)
(Thanks to Sisyphus <sisyphus1@optusnet.com.au> for drawing attention to
this problem via the PAR mailing list (par@perl.org));
@@ -480,7 +547,7 @@ v1.12 09 Mar 2005
produced by "perldoc" on some OSes.
Thanks to <cpan@calaquendi.net> for drawing attention to this problem via
- CPAN Testers (http://testers.cpan.org/).
+ CPAN Testers Reports (http://www.cpantesters.org/).
_________________
v1.11 03 Mar 2005
@@ -521,9 +588,9 @@ v1.11 03 Mar 2005
improvements:
* Added code to try to check that on Win32 the same compiler is being used
- to build these modules as was used to build Perl itself to avoid
+ to build these modules as was used to build perl itself to avoid
problems with binaries built by different compiler versions loading
- different C run-time DLLs.
+ different C RTL DLLs.
- Added a recommendation for Test::Pod to Makefile.PL to test the POD when
building these modules.
@@ -6,7 +6,7 @@
* C and XS portions of Filter::Crypto::CryptFile module.
*
* COPYRIGHT
- * Copyright (C) 2004-2009, 2012 Steve Hay. All rights reserved.
+ * Copyright (C) 2004-2009, 2012, 2014 Steve Hay. All rights reserved.
*
* LICENCE
* You may distribute under the terms of either the GNU General Public License
@@ -18,8 +18,14 @@
* C CODE SECTION
*============================================================================*/
+
+#ifdef WIN32
+# include <io.h> /* For _chsize(). */
+#else
+# include <unistd.h> /* For ftruncate(). */
+#endif
#include <stdlib.h> /* For errno. */
-#include <string.h> /* For strerror(). */
+#include <string.h> /* For strerror() and strlen(). */
#include "../CryptoCommon-c.inc"
@@ -46,14 +52,12 @@ typedef enum {
#include "const-c.inc"
-/* Before Perl 5.8.7 PerlLIO_chsize() was defined as chsize() even on systems
- * that do not have chsize(). Therefore, in those situations we define chsize()
- * to be ftruncate() if that's available instead, or else my_chsize() if
- * F_FREESP is defined (see the my_chsize() and pp_truncate() functions in Perl
- * for details). Failing that we just have to croak() via a macro with a
- * non-void type to match the context in which PerlLIO_chsize() is called. */
-#if (!defined(HAS_CHSIZE) && PERL_REVISION == 5 && \
- (PERL_VERSION < 8 || (PERL_VERSION == 8 && PERL_SUBVERSION < 7)))
+/* On systems that do not have chsize() we #define chsize() to be ftruncate() if
+ * that's available, or else my_chsize() if F_FREESP is defined (see the
+ * my_chsize() and pp_truncate() functions in Perl for details). Failing that
+ * we just have to croak() via a macro with a non-void type to match the context
+ * in which chsize() is called. */
+#if (!defined(HAS_CHSIZE))
# ifdef HAS_TRUNCATE
# define chsize(fd, size) ftruncate((fd), (size))
# elif defined(F_FREESP)
@@ -63,15 +67,15 @@ typedef enum {
# endif
#endif
-/* On Win32 PerlLIO_chsize() is defined as win32_chsize(), but unfortunately
- * that was mistakenly not exported from the Perl library before Perl 5.8.5.
- * Therefore, in that situation we have to fall back on the standard Microsoft C
- * library function chsize(), referred to by its Microsoft-specific name
- * _chsize() since chsize() is also defined as win32_chsize(). */
-#if (defined(WIN32) && PERL_REVISION == 5 && \
- (PERL_VERSION < 8 || (PERL_VERSION == 8 && PERL_SUBVERSION < 5)))
-# undef PerlLIO_chsize
-# define PerlLIO_chsize(fd, size) _chsize((fd), (size))
+/* On Win32 chsize() is #defined as win32_chsize() when PERL_IMPLICIT_SYS is not
+ * #defined, but unfortunately that was mistakenly not exported from the Perl
+ * library before Perl 5.8.5. Therefore, in that situation we have to fall back
+ * on the standard Microsoft C library function chsize(), referred to by its
+ * Microsoft-specific name _chsize(). */
+#if defined(WIN32) && !defined(PERL_IMPLICIT_SYS) && PERL_REVISION == 5 && \
+ PERL_VERSION == 8 && PERL_SUBVERSION < 5
+# undef chsize
+# define chsize(fd, size) _chsize((fd), (size))
#endif
#define FILTER_CRYPTO_SYS_ERR_STR (strerror(errno))
@@ -80,30 +84,31 @@ typedef enum {
* InputStream, OutputStream and InOutStream for convenience, so we must provide
* definitions for these "types". */
#ifndef InputStream
- typedef PerlIO * InputStream;
+ typedef PerlIO* InputStream;
#endif
#ifndef OutputStream
- typedef PerlIO * OutputStream;
+ typedef PerlIO* OutputStream;
#endif
#ifndef InOutStream
- typedef PerlIO * InOutStream;
+ typedef PerlIO* InOutStream;
#endif
static bool FilterCrypto_CryptFh(pTHX_ PerlIO *in_fh, PerlIO *out_fh,
- FILTER_CRYPTO_MODE_EX crypt_mode_ex);
+ FILTER_CRYPTO_MODE_EX crypt_mode_ex, SV* num_bytes);
static bool FilterCrypto_OutputData(pTHX_ SV *from_sv, bool encode_mode,
- bool update_mode, PerlIO *to_fh, SV *to_sv);
+ bool update_mode, PerlIO *to_fh, SV *to_sv, SV* num_bytes);
static const char *filter_crypto_use_text = "use Filter::Crypto::Decrypt;\n";
/*
* Function to encrypt or decrypt data from one filehandle to either another
* filehandle or back to itself.
- * Returns a bool to indicate success or failure.
+ * Returns a bool to indicate success or failure and sets *num_bytes to the
+ * number of bytes written.
*/
static bool FilterCrypto_CryptFh(pTHX_ PerlIO *in_fh, PerlIO *out_fh,
- FILTER_CRYPTO_MODE_EX crypt_mode_ex)
+ FILTER_CRYPTO_MODE_EX crypt_mode_ex, SV* num_bytes)
{
bool encode_mode;
bool update_mode = FALSE;
@@ -120,6 +125,9 @@ static bool FilterCrypto_CryptFh(pTHX_ PerlIO *in_fh, PerlIO *out_fh,
unsigned char *in_text = (unsigned char *)SvPVX(in_sv);
const unsigned char *buf_text;
+ SvIOK_only_UV(num_bytes);
+ sv_setuv(num_bytes, 0);
+
SvPOK_only(in_sv);
SvPOK_only(in2_sv);
SvPOK_only(out_sv);
@@ -251,6 +259,8 @@ static bool FilterCrypto_CryptFh(pTHX_ PerlIO *in_fh, PerlIO *out_fh,
#endif
}
+ sv_setuv(num_bytes, SvUV(num_bytes) + use_len);
+
/* Remember that we have input data in in_text that still needs to
* be encrypted and output. */
have_in_text = TRUE;
@@ -315,7 +325,7 @@ static bool FilterCrypto_CryptFh(pTHX_ PerlIO *in_fh, PerlIO *out_fh,
/* Write the output to the temporary output buffer or output
* filehandle as appropriate. */
if (!FilterCrypto_OutputData(aTHX_ out_sv, encode_mode, update_mode,
- out_fh, buf_sv))
+ out_fh, buf_sv, num_bytes))
{
FilterCrypto_CryptoFree(aTHX_ ctx);
ctx = NULL;
@@ -354,7 +364,7 @@ static bool FilterCrypto_CryptFh(pTHX_ PerlIO *in_fh, PerlIO *out_fh,
/* Write the final block of output to the temporary output buffer or output
* filehandle as appropriate. */
if (!FilterCrypto_OutputData(aTHX_ out_sv, encode_mode, update_mode, out_fh,
- buf_sv))
+ buf_sv, num_bytes))
{
FilterCrypto_CryptoFree(aTHX_ ctx);
ctx = NULL;
@@ -369,7 +379,7 @@ static bool FilterCrypto_CryptFh(pTHX_ PerlIO *in_fh, PerlIO *out_fh,
* write the output buffer back to the filehandle. */
if (update_mode) {
PerlIO_rewind(in_fh);
- if (PerlLIO_chsize(PerlIO_fileno(in_fh), 0) == -1) {
+ if (chsize(PerlIO_fileno(in_fh), 0) == -1) {
FilterCrypto_SetErrStr(aTHX_
"Can't truncate filehandle: %s", FILTER_CRYPTO_SYS_ERR_STR
);
@@ -399,11 +409,12 @@ static bool FilterCrypto_CryptFh(pTHX_ PerlIO *in_fh, PerlIO *out_fh,
* Function to output data from a given SV to either a filehandle or to another
* SV. The output bytes can be optionally encoded as pairs of hexadecimal
* digits. Zeroes the length of the given SV after output.
- * Returns a bool to indicate success or failure.
+ * Returns a bool to indicate success or failure and adds the number of bytes
+ * written to a third given SV.
*/
static bool FilterCrypto_OutputData(pTHX_ SV *from_sv, bool encode_mode,
- bool update_mode, PerlIO *to_fh, SV *to_sv)
+ bool update_mode, PerlIO *to_fh, SV *to_sv, SV* num_bytes)
{
SV *from2_sv = sv_2mortal(newSV(BUFSIZ * 2));
SvPOK_only(from2_sv);
@@ -425,6 +436,8 @@ static bool FilterCrypto_OutputData(pTHX_ SV *from_sv, bool encode_mode,
"Appended %d bytes to output buffer", SvCUR(from2_sv)
);
#endif
+
+ sv_setuv(num_bytes, SvUV(num_bytes) + SvCUR(from2_sv));
}
else {
/* Get the data and length to output. */
@@ -445,6 +458,8 @@ static bool FilterCrypto_OutputData(pTHX_ SV *from_sv, bool encode_mode,
"Wrote %d bytes to output stream", from2_len
);
#endif
+
+ sv_setuv(num_bytes, SvUV(num_bytes) + from2_len);
}
FilterCrypto_SvSetCUR(from_sv, 0);
@@ -485,16 +500,18 @@ _debug_mode();
# called with one in-out filehandle.
void
-_crypt_fh(fh, crypt_mode_ex);
- PROTOTYPE: $$
+_crypt_fh(fh, crypt_mode_ex, num_bytes);
+ PROTOTYPE: $$$
INPUT:
InOutStream fh;
FILTER_CRYPTO_MODE_EX crypt_mode_ex
+ SV* num_bytes
PPCODE:
{
- if (FilterCrypto_CryptFh(aTHX_ fh, (PerlIO *)NULL, crypt_mode_ex))
+ if (FilterCrypto_CryptFh(aTHX_ fh, (PerlIO *)NULL, crypt_mode_ex,
+ num_bytes))
XSRETURN_YES;
else
XSRETURN_EMPTY;
@@ -504,17 +521,18 @@ _crypt_fh(fh, crypt_mode_ex);
# called with one input filehandle and one output filehandle.
void
-_crypt_fhs(in_fh, out_fh, crypt_mode_ex);
- PROTOTYPE: $$$
+_crypt_fhs(in_fh, out_fh, crypt_mode_ex, num_bytes);
+ PROTOTYPE: $$$$
INPUT:
InputStream in_fh;
OutputStream out_fh;
FILTER_CRYPTO_MODE_EX crypt_mode_ex;
+ SV* num_bytes;
PPCODE:
{
- if (FilterCrypto_CryptFh(aTHX_ in_fh, out_fh, crypt_mode_ex))
+ if (FilterCrypto_CryptFh(aTHX_ in_fh, out_fh, crypt_mode_ex, num_bytes))
XSRETURN_YES;
else
XSRETURN_EMPTY;
@@ -7,7 +7,7 @@
# Makefile creation script.
#
# COPYRIGHT
-# Copyright (C) 2004, 2006 Steve Hay. All rights reserved.
+# Copyright (C) 2004, 2006, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -15,11 +15,12 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
+use ExtUtils::MakeMaker 6.66;
use ExtUtils::MakeMaker qw(WriteMakefile);
use File::Copy qw(copy);
use File::Spec::Functions qw(catfile updir);
@@ -46,7 +47,7 @@ MAIN: {
},
clean => {
- FILES => 'const-c.inc const-xs.inc'
+ FILES => 'const-*.inc'
}
);
@@ -7,7 +7,7 @@
# which they can be run via Filter::Crypto::Decrypt.
#
# COPYRIGHT
-# Copyright (C) 2004-2009, 2012-2013 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2009, 2012-2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -17,7 +17,7 @@
package Filter::Crypto::CryptFile;
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -55,7 +55,7 @@ BEGIN {
$ErrStr
);
- $VERSION = '2.03';
+ $VERSION = '2.05';
XSLoader::load(__PACKAGE__, $VERSION);
}
@@ -73,7 +73,7 @@ sub AUTOLOAD {
our $AUTOLOAD;
# Get the name of the constant to generate a subroutine for.
- (my $constant = $AUTOLOAD) =~ s/^.*:://;
+ (my $constant = $AUTOLOAD) =~ s/^.*:://o;
# Avoid deep recursion on AUTOLOAD() if constant() is not defined.
croak('Unexpected error in AUTOLOAD(): constant() is not defined')
@@ -96,6 +96,7 @@ sub AUTOLOAD {
sub crypt_file($;$$) {
$ErrStr = '';
+ my $num_bytes = 0;
if ( @_ == 1 or
(@_ == 2 and (not defined $_[1] or $_[1] eq '' or
@@ -132,7 +133,7 @@ sub crypt_file($;$$) {
my $crypt_mode = (@_ == 2 and defined $_[1] and $_[1] ne '')
? $_[1] : CRYPT_MODE_AUTO();
- unless (_crypt_fh($fh, $crypt_mode)) {
+ unless (_crypt_fh($fh, $crypt_mode, $num_bytes)) {
local($!, $^E);
$opened ? close $fh : $flocked ? flock $fh, LOCK_UN : 1;
return;
@@ -231,7 +232,7 @@ sub crypt_file($;$$) {
$crypt_mode = CRYPT_MODE_AUTO();
}
- unless (_crypt_fhs($in_fh, $out_fh, $crypt_mode)) {
+ unless (_crypt_fhs($in_fh, $out_fh, $crypt_mode, $num_bytes)) {
local($!, $^E);
$in_opened ? close $in_fh
: $in_flocked ? flock $in_fh, LOCK_UN : 1;
@@ -261,7 +262,7 @@ sub crypt_file($;$$) {
}
}
- return 1;
+ return $num_bytes ? $num_bytes : '0E0';
}
#===============================================================================
@@ -391,8 +392,10 @@ then the data is presumed to be in an encrypted state already so the mode will
be set to C<CRYPT_MODE_DECRYPT>; otherwise the mode will be set to
C<CRYPT_MODE_ENCRYPT>.
-Returns 1 on success, or a false value (namely, the undefined value in scalar
-context or the empty list in list context) and sets $ErrStr on failure.
+On success, returns the number of bytes written (which could be zero if the
+input was already in the requested state, in which case the special "zero but
+true" value will be returned); on failure returns the undefined value (in scalar
+context) or the empty list (in list context) and sets $ErrStr.
=back
@@ -882,9 +885,9 @@ L<Filter::Crypto>.
=head1 ACKNOWLEDGEMENTS
-The C<_PRNGInit()> and C<_GetRandNum()> functions used by the XS code are based
-on (code taken from) the C<ssl_rand_seed()> and C<ssl_rand_choosenum()>
-functions in mod_ssl (version 2.8.19-1.3.31).
+The C<FilterCrypto_PRNGInit()> and C<FilterCrypto_GetRandNum()> functions used
+by the XS code are based on code taken from the C<ssl_rand_seed()> and
+C<ssl_rand_choosenum()> functions in Apache httpd (version 2.4.9).
Thanks to Steve Henson for help with performing PBE and PKCS#5 v2.0 key
derivation with arbitrary ciphers and non-default key lengths using the OpenSSL
@@ -896,7 +899,7 @@ Steve Hay E<lt>shay@cpan.orgE<gt>
=head1 COPYRIGHT
-Copyright (C) 2004-2009, 2012-2013 Steve Hay. All rights reserved.
+Copyright (C) 2004-2009, 2012-2014 Steve Hay. All rights reserved.
=head1 LICENCE
@@ -906,11 +909,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 2.03
+Version 2.05
=head1 DATE
-08 Jul 2013
+16 May 2014
=head1 HISTORY
@@ -6,7 +6,7 @@
* Common C code for Filter::Crypto modules.
*
* COPYRIGHT
- * Copyright (C) 2004-2009, 2012-2013 Steve Hay. All rights reserved.
+ * Copyright (C) 2004-2009, 2012-2014 Steve Hay. All rights reserved.
*
* LICENCE
* You may distribute under the terms of either the GNU General Public License
@@ -36,54 +36,13 @@
# include <unistd.h>
#endif
-/* The definition of RAND_screen() is only seen if WINDOWS is #defined, which it
- * is not by default (even on Win32). The C file containing the definition
- * #includes "e_os.h" first which #define's WINDOWS if it is not aleady #defined
- * and WIN32 is (which is indeed the case on Win32). However, the header file
- * declaring RAND_screen() does not include "e_os.h" so the declaration (which,
- * before 0.9.5a, is also only seen if WINDOWS #defined) does not get seen.
- * From 0.9.5a onwards the header file declaring RAND_screen() tests if WIN32 is
- * #defined too so it works OK. Therefore, ensure WINDOWS is #defined if WIN32
- * is so that earlier versions work too. */
-#ifdef WIN32
-# ifndef WINDOWS
-# define WINDOWS
-# endif
-#endif
-
-/* For the ERR_*(), EVP_*() and RAND_*() functions.
- * The header files were located directly in the OpenSSL include directory prior
- * to 0.9.3, but are now located in an openssl/ sub-directory of that. The EVP
- * header was called "envelope.h" before 0.8.0, but is now called "evp.h." */
-#if FILTER_CRYPTO_OPENSSL_VERSION < 80000
-# include <envelope.h>
-# include <err.h>
-# include <rand.h>
-#elif FILTER_CRYPTO_OPENSSL_VERSION < 90300
-# include <err.h>
-# include <evp.h>
-# include <rand.h>
-#else
-# include <openssl/err.h>
-# include <openssl/evp.h>
-# include <openssl/rand.h>
-#endif
-
-/* Some early versions of OpenSSL and SSLeay define a "_" symbol in the "des.h"
- * header file. It is apparently not required, so undefine it since it clashes
- * with the "_" symbol defined in Perl's "config.h" header file. */
-#ifdef _
-# undef _
-#endif
-
-#define PERL_NO_GET_CONTEXT /* See the "perlguts" manpage. */
-
-#include "patchlevel.h" /* Get the version numbers first. */
-
-#if (PERL_REVISION == 5 && PERL_VERSION > 6)
-# define PERLIO_NOT_STDIO 0 /* See the "perlapio" manpage. */
-#endif
+/* For the ERR_*(), EVP_*() and RAND_*() functions. */
+#include <openssl/err.h>
+#include <openssl/evp.h>
+#include <openssl/rand.h>
+#define PERL_NO_GET_CONTEXT /* To get interp context efficiently. */
+#define PERLIO_NOT_STDIO 0 /* To allow use of PerlIO and stdio. */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
@@ -112,30 +71,6 @@
# define snprintf _snprintf
#endif
- /* PKCS5_SALT_LEN and */
- /* PKCS5_DEFAULT_ITER were added in */
- /* OpenSSL 0.9.4. */
-#ifndef PKCS5_SALT_LEN
-# define PKCS5_SALT_LEN 8
-#endif
-#ifndef PKCS5_DEFAULT_ITER
-# define PKCS5_DEFAULT_ITER 2048
-#endif
-
- /* EVP_CIPHER_block_size(), */
- /* EVP_CIPHER_CTX_block_size() and */
- /* EVP_CIPHER_iv_length() were all */
- /* added in SSLeay 0.6.5. */
-#ifndef EVP_CIPHER_block_size
-# define EVP_CIPHER_block_size(e) ((e)->block_size)
-#endif
-#ifndef EVP_CIPHER_CTX_block_size
-# define EVP_CIPHER_CTX_block_size(e) ((e)->cipher->block_size)
-#endif
-#ifndef EVP_CIPHER_iv_length
-# define EVP_CIPHER_iv_length(e) ((e)->iv_len)
-#endif
-
#define FILTER_CRYPTO_OPENSSL_ERR_STR \
(ERR_reason_error_string(FilterCrypto_GetLastSSLError()))
@@ -153,9 +88,7 @@
} STMT_END
#define FILTER_CRYPTO_NEED_RANDOM_SALT FILTER_CRYPTO_USING_PBE
-#define FILTER_CRYPTO_NEED_RANDOM_IV FILTER_CRYPTO_NEED_IV && \
- !(FILTER_CRYPTO_USING_PBE && \
- FILTER_CRYPTO_OPENSSL_VERSION < 90400)
+#define FILTER_CRYPTO_NEED_RANDOM_IV FILTER_CRYPTO_NEED_IV
/* Convert between bytes and */
/* lowercase hexadecimal digits, */
@@ -302,8 +235,7 @@ static bool FilterCrypto_CryptoInitCipher(pTHX_ FILTER_CRYPTO_CCTX *ctx,
* for the key derivation. It must be randomly generated when encrypting,
* and output with the encrypted data so that it can be read back in and
* used again for decrypting. We also need an IV, which must be handled in
- * the same way, except that the old key derivation algorithm used by
- * FilterCrypto_CipherInit() before 0.9.4 generates an IV for us. */
+ * the same way. */
#if (FILTER_CRYPTO_NEED_RANDOM_SALT || FILTER_CRYPTO_NEED_RANDOM_IV)
switch (ctx->crypt_mode) {
case FILTER_CRYPTO_MODE_ENCRYPT: {
@@ -321,8 +253,6 @@ static bool FilterCrypto_CryptoInitCipher(pTHX_ FILTER_CRYPTO_CCTX *ctx,
# if FILTER_CRYPTO_NEED_RANDOM_SALT
# if defined(FILTER_CRYPTO_NO_RAND_BYTES)
memset(salt_text, '*', ctx->required_salt_len);
-# elif FILTER_CRYPTO_OPENSSL_VERSION < 90500
- RAND_bytes(salt_text, ctx->required_salt_len);
# else
if (!RAND_bytes(salt_text, ctx->required_salt_len)) {
if (!RAND_pseudo_bytes(salt_text, ctx->required_salt_len)) {
@@ -353,8 +283,6 @@ static bool FilterCrypto_CryptoInitCipher(pTHX_ FILTER_CRYPTO_CCTX *ctx,
# if FILTER_CRYPTO_NEED_RANDOM_IV
# if defined(FILTER_CRYPTO_NO_RAND_BYTES)
memset(iv_text, '*', ctx->required_iv_len);
-# elif FILTER_CRYPTO_OPENSSL_VERSION < 90500
- RAND_bytes(iv_text, ctx->required_iv_len);
# else
if (!RAND_bytes(iv_text, ctx->required_iv_len)) {
if (!RAND_pseudo_bytes(iv_text, ctx->required_iv_len)) {
@@ -543,11 +471,7 @@ static void FilterCrypto_CryptoFree(pTHX_ FILTER_CRYPTO_CCTX *ctx) {
static bool FilterCrypto_CipherInit(pTHX_ EVP_CIPHER_CTX *ctx, SV *salt_sv,
SV *iv_sv, FILTER_CRYPTO_MODE crypt_mode)
{
-#if FILTER_CRYPTO_OPENSSL_VERSION < 90300
- EVP_CIPHER *cipher_func = FILTER_CRYPTO_CIPHER_FUNC;
-#else
const EVP_CIPHER *cipher_func = FILTER_CRYPTO_CIPHER_FUNC;
-#endif
#if FILTER_CRYPTO_KEY_LEN == 0
unsigned char *key = NULL;
#else
@@ -555,20 +479,13 @@ static bool FilterCrypto_CipherInit(pTHX_ EVP_CIPHER_CTX *ctx, SV *salt_sv,
#endif
#if FILTER_CRYPTO_NEED_RANDOM_SALT
unsigned char *salt = (unsigned char *)SvPVX(salt_sv);
-# if FILTER_CRYPTO_OPENSSL_VERSION >= 90400
int salt_len = SvCUR(salt_sv);
-# endif
#endif
#if FILTER_CRYPTO_NEED_RANDOM_IV
unsigned char *iv = (unsigned char *)SvPVX(iv_sv);
#else
unsigned char *iv = NULL;
#endif
-#if (FILTER_CRYPTO_USING_PBE && \
- FILTER_CRYPTO_OPENSSL_VERSION < 90400 && \
- FILTER_CRYPTO_OPENSSL_VERSION >= 90000)
- int derived_key_len;
-#endif
/* Derive the key from the given password. PBE should really be initialized
* with PKCS5_pbe2_set() and EVP_PBE_CipherInit(). The former generates a
@@ -590,76 +507,14 @@ static bool FilterCrypto_CipherInit(pTHX_ EVP_CIPHER_CTX *ctx, SV *salt_sv,
* PKCS5_PBKDF2_HMAC_SHA1() directly ourselves to do the PKCS#5 v2.0 key
* derivation.
* See the exchanges between myself and Steve Henson on the "openssl-users"
- * mailing list, 08-13 Sep 2004, for more details on all of this.
- * One final fly in the ointment is that PKCS5_PBKDF2_HMAC_SHA1() is only
- * available as of 0.9.4, so before that we use EVP_BytesToKey() instead.
- * This is at best PKCS#5 v1.5 compatible and also does not support non-
- * default key lengths for variable key length ciphers. In this case,
- * however, the latter is not an issue because the EVP library only has
- * facilities for changing the key lengths from 0.9.6 onwards anyway. */
-
-#if FILTER_CRYPTO_OPENSSL_VERSION < 90400
-
-# if FILTER_CRYPTO_USING_PBE
- Newxz(iv, EVP_CIPHER_iv_length(cipher_func), unsigned char);
-
- /* Do not check the return value of EVP_BytesToKey() before 0.9.0: it was
- * faulty. */
-# if FILTER_CRYPTO_OPENSSL_VERSION < 90000
- EVP_BytesToKey(cipher_func, EVP_md5(), salt, filter_crypto_pswd,
- sizeof(filter_crypto_pswd), PKCS5_DEFAULT_ITER, key, iv);
-# else
- if ((derived_key_len = EVP_BytesToKey(cipher_func, EVP_md5(), salt,
- filter_crypto_pswd, sizeof(filter_crypto_pswd), PKCS5_DEFAULT_ITER,
- key, iv)) != FILTER_CRYPTO_KEY_LEN)
- {
- Safefree(iv);
- iv = NULL;
- FilterCrypto_SetErrStr(aTHX_
- "Derived key length is wrong (%d, expected %d)",
- derived_key_len, FILTER_CRYPTO_KEY_LEN
- );
- return FALSE;
- }
-# endif
-# else
- Copy(filter_crypto_key, key, FILTER_CRYPTO_KEY_LEN, unsigned char);
-# endif
-
- EVP_CipherInit(ctx, cipher_func, key, iv, crypt_mode);
-
-# if FILTER_CRYPTO_USING_PBE
- Safefree(iv);
- iv = NULL;
-# endif
-
-#elif FILTER_CRYPTO_OPENSSL_VERSION < 90600
-
-# if FILTER_CRYPTO_USING_PBE
- if (PKCS5_PBKDF2_HMAC_SHA1(filter_crypto_pswd, sizeof(filter_crypto_pswd),
- salt, salt_len, PKCS5_DEFAULT_ITER, FILTER_CRYPTO_KEY_LEN, key) !=
- 1)
- {
- FilterCrypto_SetErrStr(aTHX_
- "Can't derive %d-byte key: %s",
- FILTER_CRYPTO_KEY_LEN, FILTER_CRYPTO_OPENSSL_ERR_STR
- );
- return FALSE;
- }
-# else
- Copy(filter_crypto_key, key, FILTER_CRYPTO_KEY_LEN, unsigned char);
-# endif
-
- EVP_CipherInit(ctx, cipher_func, key, iv, crypt_mode);
-
-#else
-
- /* From 0.9.6 onwards the EVP library API does have facilities for modifying
- * the key length for variable key length ciphers and for modifying other
- * cipher parameters, so to start with we just specify which cipher we are
- * using. Then we can set the key length and other parameters in the cipher
- * context structure thus created, and then finally derive the key and set
- * both it and the IV in the cipher context structure. */
+ * mailing list, 08-13 Sep 2004, for more details on all of this. */
+
+ /* The EVP library API has facilities for modifying the key length for
+ * variable key length ciphers and for modifying other cipher parameters, so
+ * to start with we just specify which cipher we are using. Then we can set
+ * the key length and other parameters in the cipher context structure thus
+ * created, and then finally derive the key and set both it and the IV in
+ * the cipher context structure. */
# if FILTER_CRYPTO_OPENSSL_VERSION < 90700
if (!EVP_CipherInit(ctx, cipher_func, NULL, NULL, crypt_mode)) {
FilterCrypto_SetErrStr(aTHX_
@@ -751,8 +606,6 @@ static bool FilterCrypto_CipherInit(pTHX_ EVP_CIPHER_CTX *ctx, SV *salt_sv,
}
# endif
-#endif
-
/* Wipe the key from memory now that it has been set in the cipher context.
* It's still around somewhere, of course, but at least this is one place
* less that it might be found. */
@@ -796,9 +649,6 @@ static bool FilterCrypto_CipherUpdate(pTHX_ EVP_CIPHER_CTX *ctx, SV *in_sv,
orig_out_len = SvCUR(out_sv);
out_text += orig_out_len;
-#if FILTER_CRYPTO_OPENSSL_VERSION < 90600
- EVP_CipherUpdate(ctx, out_text, &out_len, in_text, in_len);
-#else
if (!EVP_CipherUpdate(ctx, out_text, &out_len, in_text, in_len)) {
FilterCrypto_SetErrStr(aTHX_
"Can't update cipher context with %d bytes of in-text: %s",
@@ -806,7 +656,6 @@ static bool FilterCrypto_CipherUpdate(pTHX_ EVP_CIPHER_CTX *ctx, SV *in_sv,
);
return FALSE;
}
-#endif
#ifdef FILTER_CRYPTO_DEBUG_MODE
FilterCrypto_HexDump(aTHX_ out_text, out_len,
@@ -875,51 +724,44 @@ static bool FilterCrypto_CipherFinal(pTHX_ EVP_CIPHER_CTX *ctx, SV *out_sv) {
}
/*
- * Function to initialize the OpenSSL/SSLeay PRNG.
+ * Function to initialize the OpenSSL PRNG.
* Returns a bool to indicate success or failure.
*
* This function is based on code taken from the ssl_rand_seed() function in
- * mod_ssl (version 2.8.19-1.3.31).
+ * Apache httpd (version 2.4.9).
*/
static bool FilterCrypto_PRNGInit(pTHX) {
/* The PRNG is seeded transparently for us on some OSes (e.g. using UNIX's
* /dev/urandom or /dev/random devices or Win32's Crypto API) in some
* versions of OpenSSL and SSLeay, but in other cases we must do it
- * manually. From 0.9.5 onwards RAND_status() is available to report
- * whether the PRNG is seeded. Before 0.9.5 we always seed the PRNG
- * ourselves just to be sure. */
-#if FILTER_CRYPTO_OPENSSL_VERSION >= 90500
+ * manually. RAND_status() reports whether the PRNG is seeded. */
if (RAND_status())
return TRUE;
-#endif
- /* Win32 has a RAND_screen() function for seeding the PRNG from 0.6.5
- * onwards. In other cases we just have to manage ourselves. */
-#if (defined(WIN32) && FILTER_CRYPTO_OPENSSL_VERSION >= 60500)
+ /* Win32 has a RAND_screen() function for seeding the PRNG. In other cases
+ * we just have to manage ourselves. */
+#ifdef WIN32
RAND_screen();
#else
{
- time_t t;
- pid_t pid;
+ struct {
+ time_t t;
+ pid_t pid;
+ } my_seed;
int n;
unsigned char stackdata[256];
- t = time(NULL);
- RAND_seed((unsigned char *)&t, sizeof t);
+ my_seed.t = time(NULL);
+ my_seed.pid = getpid();
+ RAND_seed((unsigned char *)&my_seed, sizeof(my_seed));
- pid = getpid();
- RAND_seed((unsigned char *)&pid, sizeof pid);
-
- n = FilterCrypto_GetRandNum(aTHX_ 0, sizeof stackdata - 128 - 1);
+ n = FilterCrypto_GetRandNum(aTHX_ 0, sizeof(stackdata) - 128 - 1);
RAND_seed(stackdata + n, 128);
}
#endif
- /* We cannot check whether we have seeded the PRNG with enough entropy
- * before 0.9.5, so we just return TRUE in that case and hope for the
- * best. */
-#if FILTER_CRYPTO_OPENSSL_VERSION >= 90500
+ /* Check whether we have seeded the PRNG with enough entropy. */
if (RAND_status()) {
return TRUE;
}
@@ -927,16 +769,13 @@ static bool FilterCrypto_PRNGInit(pTHX) {
FilterCrypto_SetErrStr(aTHX_ "Can't initialize PRNG");
return FALSE;
}
-#else
- return TRUE;
-#endif
}
/*
* Function to return a random number between min and max.
*
- * This function is based on the ssl_rand_choosenum() function in mod_ssl
- * (version 2.8.19-1.3.31).
+ * This function is based on the ssl_rand_choosenum() function in Apache httpd
+ * (version 2.4.9).
*/
static int FilterCrypto_GetRandNum(pTHX_ int min, int max) {
@@ -946,7 +785,7 @@ static int FilterCrypto_GetRandNum(pTHX_ int min, int max) {
seedDrand01((Rand_seed_t)time(NULL));
PL_srand_called = TRUE;
- snprintf(buf, sizeof buf, "%.0f", Drand01() * (max - min));
+ snprintf(buf, sizeof(buf), "%.0f", Drand01() * (max - min));
n = atoi(buf) + 1;
@@ -960,7 +799,7 @@ static int FilterCrypto_GetRandNum(pTHX_ int min, int max) {
}
/*
- * Function to get the last (most recent) OpenSSL/SSLeay error from the current
+ * Function to get the last (most recent) OpenSSL error from the current
* thread's error queue.
*/
@@ -6,7 +6,7 @@
# Common XS code for Filter::Crypto modules.
#
# COPYRIGHT
-# Copyright (C) 2004-2009 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2009, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -14,6 +14,8 @@
#
#===============================================================================
+#include <string.h> /* For strcpy and strcat()(). */
+
#define FILTER_CRYPTO_ERRSTR_VARIABLE "::ErrStr"
BOOT:
@@ -72,17 +74,12 @@ DESTROY(self)
#endif
/* Free the current thread's error queue and all previously loaded error
- * strings. ERR_remove_state() was added in SSLeay 0.6.1, but seems to
- * crash before 0.6.4. */
-#if FILTER_CRYPTO_OPENSSL_VERSION >= 60400
+ * strings. */
ERR_remove_state(0);
-#endif
ERR_free_strings();
/* Remove all ciphers and/or digests from the internal lookup table. */
-#if FILTER_CRYPTO_OPENSSL_VERSION >= 80000
EVP_cleanup();
-#endif
/* Free the PRNG state. */
RAND_cleanup();
@@ -6,7 +6,7 @@
* C and XS portions of Filter::Crypto::Decrypt module.
*
* COPYRIGHT
- * Copyright (C) 2004-2009, 2012 Steve Hay. All rights reserved.
+ * Copyright (C) 2004-2009, 2012, 2014 Steve Hay. All rights reserved.
*
* LICENCE
* You may distribute under the terms of either the GNU General Public License
@@ -32,7 +32,9 @@ typedef enum {
typedef struct {
MAGIC *mg_ptr;
FILTER_CRYPTO_CCTX *crypto_ctx;
+ SV *encrypt_sv;
SV *decrypt_sv;
+ SV *encode_sv;
int filter_count;
FILTER_CRYPTO_STATUS filter_status;
} FILTER_CRYPTO_FCTX;
@@ -41,8 +43,7 @@ static I32 FilterCrypto_ReadBlock(pTHX_ int idx, SV *sv, int want_size);
static FILTER_CRYPTO_FCTX *FilterCrypto_FilterAlloc(pTHX);
static bool FilterCrypto_FilterInit(pTHX_ FILTER_CRYPTO_FCTX *ctx,
FILTER_CRYPTO_MODE crypt_mode);
-static bool FilterCrypto_FilterUpdate(pTHX_ FILTER_CRYPTO_FCTX *ctx,
- SV *encrypt_sv);
+static bool FilterCrypto_FilterUpdate(pTHX_ FILTER_CRYPTO_FCTX *ctx);
static bool FilterCrypto_FilterFinal(pTHX_ FILTER_CRYPTO_FCTX *ctx);
static void FilterCrypto_FilterFree(pTHX_ FILTER_CRYPTO_FCTX *ctx);
static int FilterCrypto_FilterSvMgFree(pTHX_ SV *sv, MAGIC *mg);
@@ -129,9 +130,13 @@ static FILTER_CRYPTO_FCTX *FilterCrypto_FilterAlloc(pTHX) {
/* Allocate the crypto context. */
ctx->crypto_ctx = FilterCrypto_CryptoAlloc(aTHX);
- /* Allocate the decrypt buffer. */
+ /* Allocate the encrypt, decrypt and encode buffers. */
+ ctx->encrypt_sv = newSV(BUFSIZ);
ctx->decrypt_sv = newSV(BUFSIZ);
+ ctx->encode_sv = newSV(BUFSIZ * 2);
+ SvPOK_only(ctx->encrypt_sv);
SvPOK_only(ctx->decrypt_sv);
+ SvPOK_only(ctx->encode_sv);
return ctx;
}
@@ -148,8 +153,10 @@ static bool FilterCrypto_FilterInit(pTHX_ FILTER_CRYPTO_FCTX *ctx,
if (!FilterCrypto_CryptoInit(aTHX_ ctx->crypto_ctx, crypt_mode))
return FALSE;
- /* Initialize the decrypt buffer. */
+ /* Initialize the encrypt, decrypt and encode buffers. */
+ FilterCrypto_SvSetCUR(ctx->encrypt_sv, 0);
FilterCrypto_SvSetCUR(ctx->decrypt_sv, 0);
+ FilterCrypto_SvSetCUR(ctx->encode_sv, 0);
/* Initialize the filter count and status. */
ctx->filter_count = FILTER_CRYPTO_FILTER_COUNT;
@@ -159,17 +166,16 @@ static bool FilterCrypto_FilterInit(pTHX_ FILTER_CRYPTO_FCTX *ctx,
}
/*
- * Function to update the given filter context with encrypted data in the given
- * encrypt SV. This data is not assumed to be null-terminated, so the correct
- * length must be set in SvCUR(encrypt_sv). The decrypted output data will be
- * written into an SV within the filter context.
+ * Function to update the given filter context with encrypted data given in an
+ * SV within the filter context. This data is not assumed to be
+ * null-terminated, so the correct length must be set in SvCUR(ctx->encrypt_sv).
+ * The decrypted output data will be written into an SV within the filter
+ * context.
* Returns a bool to indicate success or failure.
*/
-static bool FilterCrypto_FilterUpdate(pTHX_ FILTER_CRYPTO_FCTX *ctx,
- SV *encrypt_sv)
-{
- return FilterCrypto_CryptoUpdate(aTHX_ ctx->crypto_ctx, encrypt_sv,
+static bool FilterCrypto_FilterUpdate(pTHX_ FILTER_CRYPTO_FCTX *ctx) {
+ return FilterCrypto_CryptoUpdate(aTHX_ ctx->crypto_ctx, ctx->encrypt_sv,
ctx->decrypt_sv);
}
@@ -188,8 +194,11 @@ static bool FilterCrypto_FilterFinal(pTHX_ FILTER_CRYPTO_FCTX *ctx) {
*/
static void FilterCrypto_FilterFree(pTHX_ FILTER_CRYPTO_FCTX *ctx) {
- /* Free the decrypt buffer by decrementing its reference count (to zero). */
+ /* Free the encode, decrypt and encrypt buffers by decrementing their
+ * reference counts (to zero). */
+ SvREFCNT_dec(ctx->encode_sv);
SvREFCNT_dec(ctx->decrypt_sv);
+ SvREFCNT_dec(ctx->encrypt_sv);
/* Free the crypto context. */
FilterCrypto_CryptoFree(aTHX_ ctx->crypto_ctx);
@@ -219,10 +228,11 @@ static int FilterCrypto_FilterSvMgFree(pTHX_ SV *sv, MAGIC *mg) {
/*
* Function to perform the source code decryption filtering. Data is first read
- * from the input stream into an encode buffer containing a plain ASCII encoding
- * of the encrypted data, and then decoded into an encrypt buffer. It is then
- * decrypted into a decrypt buffer within the filter context, and is finally
- * written to the output stream buffer (which is the buf_sv argument).
+ * from the input stream into an encode buffer within the filter context
+ * containing a plain ASCII encoding of the encrypted data, and then decoded
+ * into an encrypt buffer within the filter context. It is then decrypted into
+ * a decrypt buffer within the filter context, and is finally written to the
+ * output stream buffer (which is the buf_sv argument).
* Returns the number of bytes written to the output stream buffer, or 0 if EOF
* was reached before anything was written, or croak()s on failure.
* The filter is deleted when the decryption is finished or an error occurs.
@@ -240,8 +250,6 @@ static int FilterCrypto_FilterSvMgFree(pTHX_ SV *sv, MAGIC *mg) {
static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
FILTER_CRYPTO_FCTX *ctx;
SV *filter_sv = FILTER_DATA(idx);
- SV *encode_sv = sv_2mortal(newSV(BUFSIZ * 2));
- SV *encrypt_sv = sv_2mortal(newSV(BUFSIZ));
MAGIC *mg;
I32 m;
I32 n;
@@ -250,9 +258,6 @@ static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
const char *nl = "\n";
char *p;
- SvPOK_only(encode_sv);
- SvPOK_only(encrypt_sv);
-
/* Recover the filter context pointer that is held within the MAGIC of the
* filter's SV, and verify that we have found the correct MAGIC. */
if (!(mg = mg_find(filter_sv, PERL_MAGIC_ext))) {
@@ -269,6 +274,10 @@ static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
"\"signature\"");
}
+ /* Reinitialize the encode and encrypt buffers. */
+ FilterCrypto_SvSetCUR(ctx->encode_sv, 0);
+ FilterCrypto_SvSetCUR(ctx->encrypt_sv, 0);
+
/* Check if this is the first time through. */
if (ctx->filter_status == FILTER_CRYPTO_STATUS_NOT_STARTED) {
#ifdef FILTER_CRYPTO_DEBUG_MODE
@@ -288,7 +297,7 @@ static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
while (1) {
/* If there is anything currently in the decrypt buffer then write (part
* of) it to the output stream buffer. How much we write depends on
- * what Perl has asked for. */
+ * what perl has asked for. */
if ((m = SvCUR(ctx->decrypt_sv)) > 0) {
out_ptr = (const unsigned char *)SvPVX_const(ctx->decrypt_sv);
@@ -316,7 +325,7 @@ static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
else {
/* Perl has asked for a complete line of source code. We must
* not return here if the decrypt buffer does not hold at least
- * one complete line because Perl compiles each line as it is
+ * one complete line because perl compiles each line as it is
* returned and hence would generate a syntax error if we have
* written only part of a line to the output stream buffer.
* Instead, we must carry on and read some more data from the
@@ -396,13 +405,13 @@ static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
FilterCrypto_SvSetCUR(ctx->decrypt_sv, 0);
SvOOK_off(ctx->decrypt_sv);
- n = FilterCrypto_ReadBlock(aTHX_ idx + 1, encode_sv, BUFSIZ * 2);
+ n = FilterCrypto_ReadBlock(aTHX_ idx + 1, ctx->encode_sv, BUFSIZ * 2);
if (n > 0) {
/* We have read a new block of data from the input stream into the
* encode buffer, so set the length of the encode buffer and decode
* it into the encrypt buffer. */
- FilterCrypto_SvSetCUR(encode_sv, n);
- if (!FilterCrypto_DecodeSV(aTHX_ encode_sv, encrypt_sv)) {
+ FilterCrypto_SvSetCUR(ctx->encode_sv, n);
+ if (!FilterCrypto_DecodeSV(aTHX_ ctx->encode_sv, ctx->encrypt_sv)) {
filter_del(FilterCrypto_FilterDecrypt);
croak("Can't continue decryption: %s",
FilterCrypto_GetErrStr(aTHX));
@@ -410,11 +419,11 @@ static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
/* The decoding succeeded, so zero the encode buffer's length ready
* for the next call to FilterCrypto_ReadBlock(). */
- FilterCrypto_SvSetCUR(encode_sv, 0);
+ FilterCrypto_SvSetCUR(ctx->encode_sv, 0);
/* We have decoded a new block of data from the encode buffer into
* the encrypt buffer, so decrypt it into the decrypt buffer. */
- if (!FilterCrypto_FilterUpdate(aTHX_ ctx, encrypt_sv)) {
+ if (!FilterCrypto_FilterUpdate(aTHX_ ctx)) {
filter_del(FilterCrypto_FilterDecrypt);
croak("Can't continue decryption: %s",
FilterCrypto_GetErrStr(aTHX));
@@ -422,7 +431,7 @@ static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
/* The decryption succeeded, so zero the encrypt buffer's length
* ready for the next call to FilterCrypto_ReadBlock(). */
- FilterCrypto_SvSetCUR(encrypt_sv, 0);
+ FilterCrypto_SvSetCUR(ctx->encrypt_sv, 0);
}
else if (n == 0) {
/* We did not read any data from the input stream, and have now
@@ -450,9 +459,9 @@ static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
}
/*
- * Function to determine whether the Perl running it is a DEBUGGING build. This
+ * Function to determine whether the perl running it is a DEBUGGING build. This
* is tested by trying out the "hash dump" debugging feature, which should usurp
- * the built-in values() function if and only if this is a DEBUGGING Perl, thus
+ * the built-in values() function if and only if this is a DEBUGGING perl, thus
* providing a more reliable (though clearly still not infallible) indicator
* than inspecting the contents of Config.pm.
*
@@ -490,24 +499,24 @@ INCLUDE: ../CryptoCommon-xs.inc
BOOT:
{
#ifndef FILTER_CRYPTO_DEBUG_MODE
- /* C compile-time check that this not a DEBUGGING Perl.
+ /* C compile-time check that this not a DEBUGGING perl.
* i.e. built with -DDEBUGGING. */
# ifdef DEBUGGING
-# error Do not build with DEBUGGING Perl!
+# error Do not build with DEBUGGING perl!
# endif
/* Check that we are not running with DEBUGGING flags enabled.
* e.g. perl -Dp <script>
- * Do this check before the check for a DEBUGGING Perl below because that
+ * Do this check before the check for a DEBUGGING perl below because that
* check currently seems to always trigger this check to fail even though
* its alteration of $^D is local()ized. */
if (PL_debug)
croak("Can't run with DEBUGGING flags");
- /* Check that we are not running under a DEBUGGING Perl.
+ /* Check that we are not running under a DEBUGGING perl.
* i.e. built with -DDEBUGGING. */
if (FilterCrypto_IsDebugPerl(aTHX))
- croak("Can't run with DEBUGGING Perl");
+ croak("Can't run with DEBUGGING perl");
/* Check that we are not running with the Perl debugger enabled.
* e.g. perl -d:ptkdb <script> */
@@ -523,7 +532,7 @@ BOOT:
#endif
}
-# Import function, automatically called by Perl when processing the
+# Import function, automatically called by perl when processing the
# "use Filter::Crypto::Decrypt;" line, to initialize the decryption filter's
# context.
@@ -553,28 +562,9 @@ import(module, ...)
* be automatically freed when the SV is destroyed, and store the
* pointer within the MAGIC (specifically, as the mg_ptr member) so that
* it cannot be messed with.
- * From Perl 5.7.3 onwards we can use sv_magicext(). Pass 0 as the
- * length of the mg_ptr member-to-be so that it is stored as-is, rather
- * than a savepvn() copy of it being stored.
- * Before 5.7.3 we have to do it the hard way, using sv_magic(). Note
- * that this stores a savepvn() copy of the mg_ptr member-to-be for all
- * lengths >= 0, so instead we just pass ((char *)NULL, 0) and assign
- * ctx to the mg_ptr member later. (We cannot pass (ctx, sizeof(*ctx))
- * and then assign mg->mg_ptr back to ctx because the original ctx would
- * need to be freed, but we cannot use FilterCrypto_FilterFree() to free
- * it since savepvn() will only have made a shallow copy.) */
+ * Pass 0 as the length of the mg_ptr member-to-be so that it is stored
+ * as-is, rather than a savepvn() copy of it being stored. */
filter_sv = newSV(0);
-#if (PERL_REVISION == 5 && \
- (PERL_VERSION < 7 || (PERL_VERSION == 7 && PERL_SUBVERSION < 3)))
- sv_magic(filter_sv, (SV *)NULL, PERL_MAGIC_ext, (char *)NULL, 0);
- if (!(mg = mg_find(filter_sv, PERL_MAGIC_ext))) {
- FilterCrypto_FilterFree(aTHX_ ctx);
- ctx = NULL;
- croak("Can't add MAGIC to decryption filter's SV");
- }
- mg->mg_ptr = (char *)ctx;
- mg->mg_virtual = (MGVTBL *)&FilterCrypto_FilterSvMgVTBL;
-#else
if (!(mg = sv_magicext(filter_sv, (SV *)NULL, PERL_MAGIC_ext,
(MGVTBL *)&FilterCrypto_FilterSvMgVTBL, (char *)ctx, 0)))
{
@@ -582,7 +572,6 @@ import(module, ...)
ctx = NULL;
croak("Can't add MAGIC to decryption filter's SV");
}
-#endif
/* Store a pointer back to the MAGIC within the filter context structure
* itself so that we can verify later that we have retrieved the correct
@@ -7,7 +7,7 @@
# Makefile creation script.
#
# COPYRIGHT
-# Copyright (C) 2004, 2006 Steve Hay. All rights reserved.
+# Copyright (C) 2004, 2006, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -15,11 +15,12 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
+use ExtUtils::MakeMaker 6.66;
use ExtUtils::MakeMaker qw(WriteMakefile);
use File::Spec::Functions qw(catfile updir);
@@ -7,7 +7,7 @@
# been encrypted via Filter::Crypto::CryptFile.
#
# COPYRIGHT
-# Copyright (C) 2004-2009, 2012 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2009, 2012, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -17,7 +17,7 @@
package Filter::Crypto::Decrypt;
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -31,7 +31,7 @@ use XSLoader qw();
our($VERSION);
BEGIN {
- $VERSION = '2.02';
+ $VERSION = '2.03';
XSLoader::load(__PACKAGE__, $VERSION);
}
@@ -108,13 +108,13 @@ maintain state could not be found.
=item Can't run with DEBUGGING flags
-(F) The encrypted Perl file is being run by a Perl with DEBUGGING flags enabled,
+(F) The encrypted Perl file is being run by a perl with DEBUGGING flags enabled,
e.g. C<perl -Dp F<file>>. This is not allowed since it may assist in retrieving
the original unencrypted source code.
-=item Can't run with DEBUGGING Perl
+=item Can't run with DEBUGGING perl
-(F) The encrypted Perl file is being run by a Perl that was built with DEBUGGING
+(F) The encrypted Perl file is being run by a perl that was built with DEBUGGING
enabled, i.e. C<-DDEBUGGING>. This is not allowed since it may assist in
retrieving the original unencrypted source code.
@@ -126,13 +126,13 @@ allowed since it may assist in retrieving the original unencrypted source code.
=item Can't run with Perl compiler backend
-(F) The encrypted Perl file is being run by a Perl with the Perl compiler
+(F) The encrypted Perl file is being run by a perl with the Perl compiler
backend enabled, e.g. C<perl -MO=Deparse F<file>>. This is not allowed since it
may assist in retrieving the original unencrypted source code.
=item Can't run with Perl debugger
-(F) The encrypted Perl file is being run by a Perl with the Perl debugger
+(F) The encrypted Perl file is being run by a perl with the Perl debugger
enabled, e.g. C<perl -d:ptkdb F<file>>. This is not allowed since it may assist
in retrieving the original unencrypted source code.
@@ -188,7 +188,7 @@ is written in XS and C.)
=head1 ACKNOWLEDGEMENTS
Much of the XS code is based on that in the Filter::decrypt module (version
-1.04), written by Paul Marquess.
+1.49), written by Paul Marquess.
Thanks to Nick Ing-Simmons for help in getting the MAGIC attached to the
decryption filter's SV working.
@@ -199,7 +199,7 @@ Steve Hay E<lt>shay@cpan.orgE<gt>
=head1 COPYRIGHT
-Copyright (C) 2004-2009, 2012-2013 Steve Hay. All rights reserved.
+Copyright (C) 2004-2009, 2012-2014 Steve Hay. All rights reserved.
=head1 LICENCE
@@ -209,11 +209,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 2.02
+Version 2.03
=head1 DATE
-14 Feb 2013
+16 May 2014
=head1 HISTORY
@@ -1,66 +1,40 @@
________________________________________________________________________________
- Filter::Crypto, Version 2.03
+ Filter::Crypto, Version 2.06
________________________________________________________________________________
PREREQUISITES
- Compiler
+ C Compiler
You need a C compiler to build these modules.
- Note that you should try to use the same compiler as was used to build
- your Perl itself.
-
- In particular, Windows users should be aware that these modules will not
- work correctly if they load a different C run-time DLL to that loaded by
- perl itself. Note that Visual C++ 6.0 (part of Visual Studio 6.0) and
- earlier produce binaries that require the system's msvcrt.dll, while
- Visual C++ .NET (aka Visual C++ 7.0, part of Visual Studio .NET), Visual
- C++ .NET 2003 (aka Visual C++ 7.1, part of Visual Studio .NET 2003 and
- the free Visual C++ Toolkit 2003), Visual C++ 2005 (aka Visual C++ 8.0,
- part of Visual Studio 2005 and the free Visual C++ 2005 Express Edition)
- and later produce binaries that require compiler-specific DLLs named
- msvcr70.dll, msvcr71.dll, msvcr80.dll etc. Therefore, building these
- modules with anything later than VC6 for use with ActivePerl, which is
- known currently to be built with VC6, will not work.
-
- On Windows, the Makefile.PL script will try to detect if a different
- compiler is being used and will give an error if necessary. Note,
- however, that it is not always possible for it to detect which
- particular compiler version was used to build Perl, especially for Perl
- version 5.8.6 or older, which did not have this information stored in
- the standard library module Config.
+ Ideally you should try to use the same compiler as was used to build
+ your perl itself, although this is not essential. (However, there is a
+ known compatibility problem when building this module with Visual Studio
+ .NET 2002/2003 (VC7) or earlier if your perl was built with Visual
+ Studio 2005 (VC8) or later: see [perl #121448].)
OpenSSL
- OpenSSL (any version), or SSLeay version 0.6.0 or later.
+ OpenSSL version 0.9.6k or 0.9.7c or later.
The latest version of OpenSSL is available from http://www.openssl.org/.
Perl
- Perl version 5.6.0 or later.
+ Perl version 5.8.1 or later.
The latest version of Perl is available from http://www.perl.com/.
Perl Modules
There are no non-standard Perl modules required by the two main modules
in this distribution (Filter::Crypto::CryptFile and
- Filter::Crypto::Decrypt), but the crypt_file script and the
- PAR::Filter::Crypto module both require
-
- File::Temp
-
- which is only a standard Perl module from Perl version 5.6.1 onwards
- (crypt_file only requires it when run with the "-e tempfile" option),
- and the PAR::Filter::Crypto module also requires
+ Filter::Crypto::Decrypt), but the PAR::Filter::Crypto module requires
PAR::Filter
- which is part of the PAR distribution.
-
- A standalone distribution of the File::Temp module, as well as the PAR
- distribution, is available from CPAN (http://www.cpan.org/).
+ which is part of the PAR::Packer distribution, available from CPAN
+ (http://www.cpan.org/).
INSTALLATION
@@ -83,10 +57,9 @@ INSTALLATION
for more details.
- On Microsoft Windows platforms, you will need to use "nmake" or "dmake"
- rather than "make" in the commands above, depending on what your Perl was
- built with. To determine which make program was used to build your Perl
- type the following:
+ On Windows, you will need to use "nmake" or "dmake" rather than "make" in
+ the commands above, depending on what your perl was built with. To
+ determine which make program was used to build your perl type the following:
perl -V:make
________________________________________________________________________________
@@ -1,6 +1,6 @@
________________________________________________________________________________
- Filter::Crypto, Version 2.03
+ Filter::Crypto, Version 2.06
________________________________________________________________________________
This distribution is free software; you can redistribute it and/or modify it
@@ -27,64 +27,216 @@ distribution, in the file named "Artistic". If not, visit the Perl web page on
the internet at http://dev.perl.org/licenses/artistic.html.
________________________________________________________________________________
-Note that this distribution depends on OpenSSL (or SSLeay), which are licensed
-under BSD-style licences that are incompatible with the GPL option of this
+Note that this distribution depends on OpenSSL, which is licensed under a
+BSD-style licence that is incompatible with the GPL option of this
distribution's licensing. The licence for the two functions mentioned below is
also a similar BSD-style licence.
________________________________________________________________________________
-The _PRNGInit() and _GetRandNum() functions in CryptoCommon.c are based on (code
-taken from) the ssl_rand_seed() and ssl_rand_choosenum() functions in
-pkg.sslmod/ssl_engine_rand.c within mod_ssl (version 2.8.19-1.3.31), which is
-subject to the following terms:
-
- ====================================================================
- Copyright (c) 1998-2004 Ralf S. Engelschall. All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions
- are met:
-
- 1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
- 2. Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following
- disclaimer in the documentation and/or other materials
- provided with the distribution.
-
- 3. All advertising materials mentioning features or use of this
- software must display the following acknowledgment:
- "This product includes software developed by
- Ralf S. Engelschall <rse@engelschall.com> for use in the
- mod_ssl project (http://www.modssl.org/)."
-
- 4. The names "mod_ssl" must not be used to endorse or promote
- products derived from this software without prior written
- permission. For written permission, please contact
- rse@engelschall.com.
-
- 5. Products derived from this software may not be called "mod_ssl"
- nor may "mod_ssl" appear in their names without prior
- written permission of Ralf S. Engelschall.
-
- 6. Redistributions of any form whatsoever must retain the following
- acknowledgment:
- "This product includes software developed by
- Ralf S. Engelschall <rse@engelschall.com> for use in the
- mod_ssl project (http://www.modssl.org/)."
-
- THIS SOFTWARE IS PROVIDED BY RALF S. ENGELSCHALL ``AS IS'' AND ANY
- EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL RALF S. ENGELSCHALL OR
- HIS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
- NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
- OF THE POSSIBILITY OF SUCH DAMAGE.
- ====================================================================
+The FilterCrypto_PRNGInit() and FilterCrypto_GetRandNum() functions in
+CryptoCommon-c.inc are based on code taken from the ssl_rand_seed() and
+ssl_rand_choosenum() functions in modules/ssl/ssl_engine_rand.c within Apache
+httpd (version 2.4.9), which is subject to the following terms:
+
+ Apache License
+ Version 2.0, January 2004
+ http://www.apache.org/licenses/
+
+ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+ 1. Definitions.
+
+ "License" shall mean the terms and conditions for use, reproduction,
+ and distribution as defined by Sections 1 through 9 of this document.
+
+ "Licensor" shall mean the copyright owner or entity authorized by
+ the copyright owner that is granting the License.
+
+ "Legal Entity" shall mean the union of the acting entity and all
+ other entities that control, are controlled by, or are under common
+ control with that entity. For the purposes of this definition,
+ "control" means (i) the power, direct or indirect, to cause the
+ direction or management of such entity, whether by contract or
+ otherwise, or (ii) ownership of fifty percent (50%) or more of the
+ outstanding shares, or (iii) beneficial ownership of such entity.
+
+ "You" (or "Your") shall mean an individual or Legal Entity
+ exercising permissions granted by this License.
+
+ "Source" form shall mean the preferred form for making modifications,
+ including but not limited to software source code, documentation
+ source, and configuration files.
+
+ "Object" form shall mean any form resulting from mechanical
+ transformation or translation of a Source form, including but
+ not limited to compiled object code, generated documentation,
+ and conversions to other media types.
+
+ "Work" shall mean the work of authorship, whether in Source or
+ Object form, made available under the License, as indicated by a
+ copyright notice that is included in or attached to the work
+ (an example is provided in the Appendix below).
+
+ "Derivative Works" shall mean any work, whether in Source or Object
+ form, that is based on (or derived from) the Work and for which the
+ editorial revisions, annotations, elaborations, or other modifications
+ represent, as a whole, an original work of authorship. For the purposes
+ of this License, Derivative Works shall not include works that remain
+ separable from, or merely link (or bind by name) to the interfaces of,
+ the Work and Derivative Works thereof.
+
+ "Contribution" shall mean any work of authorship, including
+ the original version of the Work and any modifications or additions
+ to that Work or Derivative Works thereof, that is intentionally
+ submitted to Licensor for inclusion in the Work by the copyright owner
+ or by an individual or Legal Entity authorized to submit on behalf of
+ the copyright owner. For the purposes of this definition, "submitted"
+ means any form of electronic, verbal, or written communication sent
+ to the Licensor or its representatives, including but not limited to
+ communication on electronic mailing lists, source code control systems,
+ and issue tracking systems that are managed by, or on behalf of, the
+ Licensor for the purpose of discussing and improving the Work, but
+ excluding communication that is conspicuously marked or otherwise
+ designated in writing by the copyright owner as "Not a Contribution."
+
+ "Contributor" shall mean Licensor and any individual or Legal Entity
+ on behalf of whom a Contribution has been received by Licensor and
+ subsequently incorporated within the Work.
+
+ 2. Grant of Copyright License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ copyright license to reproduce, prepare Derivative Works of,
+ publicly display, publicly perform, sublicense, and distribute the
+ Work and such Derivative Works in Source or Object form.
+
+ 3. Grant of Patent License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ (except as stated in this section) patent license to make, have made,
+ use, offer to sell, sell, import, and otherwise transfer the Work,
+ where such license applies only to those patent claims licensable
+ by such Contributor that are necessarily infringed by their
+ Contribution(s) alone or by combination of their Contribution(s)
+ with the Work to which such Contribution(s) was submitted. If You
+ institute patent litigation against any entity (including a
+ cross-claim or counterclaim in a lawsuit) alleging that the Work
+ or a Contribution incorporated within the Work constitutes direct
+ or contributory patent infringement, then any patent licenses
+ granted to You under this License for that Work shall terminate
+ as of the date such litigation is filed.
+
+ 4. Redistribution. You may reproduce and distribute copies of the
+ Work or Derivative Works thereof in any medium, with or without
+ modifications, and in Source or Object form, provided that You
+ meet the following conditions:
+
+ (a) You must give any other recipients of the Work or
+ Derivative Works a copy of this License; and
+
+ (b) You must cause any modified files to carry prominent notices
+ stating that You changed the files; and
+
+ (c) You must retain, in the Source form of any Derivative Works
+ that You distribute, all copyright, patent, trademark, and
+ attribution notices from the Source form of the Work,
+ excluding those notices that do not pertain to any part of
+ the Derivative Works; and
+
+ (d) If the Work includes a "NOTICE" text file as part of its
+ distribution, then any Derivative Works that You distribute must
+ include a readable copy of the attribution notices contained
+ within such NOTICE file, excluding those notices that do not
+ pertain to any part of the Derivative Works, in at least one
+ of the following places: within a NOTICE text file distributed
+ as part of the Derivative Works; within the Source form or
+ documentation, if provided along with the Derivative Works; or,
+ within a display generated by the Derivative Works, if and
+ wherever such third-party notices normally appear. The contents
+ of the NOTICE file are for informational purposes only and
+ do not modify the License. You may add Your own attribution
+ notices within Derivative Works that You distribute, alongside
+ or as an addendum to the NOTICE text from the Work, provided
+ that such additional attribution notices cannot be construed
+ as modifying the License.
+
+ You may add Your own copyright statement to Your modifications and
+ may provide additional or different license terms and conditions
+ for use, reproduction, or distribution of Your modifications, or
+ for any such Derivative Works as a whole, provided Your use,
+ reproduction, and distribution of the Work otherwise complies with
+ the conditions stated in this License.
+
+ 5. Submission of Contributions. Unless You explicitly state otherwise,
+ any Contribution intentionally submitted for inclusion in the Work
+ by You to the Licensor shall be under the terms and conditions of
+ this License, without any additional terms or conditions.
+ Notwithstanding the above, nothing herein shall supersede or modify
+ the terms of any separate license agreement you may have executed
+ with Licensor regarding such Contributions.
+
+ 6. Trademarks. This License does not grant permission to use the trade
+ names, trademarks, service marks, or product names of the Licensor,
+ except as required for reasonable and customary use in describing the
+ origin of the Work and reproducing the content of the NOTICE file.
+
+ 7. Disclaimer of Warranty. Unless required by applicable law or
+ agreed to in writing, Licensor provides the Work (and each
+ Contributor provides its Contributions) on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ implied, including, without limitation, any warranties or conditions
+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+ PARTICULAR PURPOSE. You are solely responsible for determining the
+ appropriateness of using or redistributing the Work and assume any
+ risks associated with Your exercise of permissions under this License.
+
+ 8. Limitation of Liability. In no event and under no legal theory,
+ whether in tort (including negligence), contract, or otherwise,
+ unless required by applicable law (such as deliberate and grossly
+ negligent acts) or agreed to in writing, shall any Contributor be
+ liable to You for damages, including any direct, indirect, special,
+ incidental, or consequential damages of any character arising as a
+ result of this License or out of the use or inability to use the
+ Work (including but not limited to damages for loss of goodwill,
+ work stoppage, computer failure or malfunction, or any and all
+ other commercial damages or losses), even if such Contributor
+ has been advised of the possibility of such damages.
+
+ 9. Accepting Warranty or Additional Liability. While redistributing
+ the Work or Derivative Works thereof, You may choose to offer,
+ and charge a fee for, acceptance of support, warranty, indemnity,
+ or other liability obligations and/or rights consistent with this
+ License. However, in accepting such obligations, You may act only
+ on Your own behalf and on Your sole responsibility, not on behalf
+ of any other Contributor, and only if You agree to indemnify,
+ defend, and hold each Contributor harmless for any liability
+ incurred by, or claims asserted against, such Contributor by reason
+ of your accepting any such warranty or additional liability.
+
+ END OF TERMS AND CONDITIONS
+
+ APPENDIX: How to apply the Apache License to your work.
+
+ To apply the Apache License to your work, attach the following
+ boilerplate notice, with the fields enclosed by brackets "[]"
+ replaced with your own identifying information. (Don't include
+ the brackets!) The text should be enclosed in the appropriate
+ comment syntax for the file format. We also recommend that a
+ file or class name and description of purpose be included on the
+ same "printed page" as the copyright notice for easier
+ identification within third-party archives.
+
+ Copyright [yyyy] [name of copyright owner]
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
________________________________________________________________________________
@@ -1,45 +1,37 @@
-Artistic The "Artistic License"
-Changes Differences from previous version
-Copying The GNU General Public License
-CryptoCommon-c.inc Filter::Crypto::* extensions common C code
-CryptoCommon-xs.inc Filter::Crypto::* extensions common external subroutines
-INSTALL Detailed installation instructions
-LICENCE The Licence
-Makefile.PL Filter::Crypto makefile writer
-MANIFEST This list of files
-MANIFEST.SKIP Manifest skip specs
-META.yml Distribution meta-data in YAML
-README The Instructions
-ppport.h Perl/Pollution/Portability header
-CryptFile/CryptFile.xs Filter::Crypto::CryptFile extension external subroutines
-CryptFile/Makefile.PL Filter::Crypto::CryptFile extension makefile writer
-CryptFile/typemap Filter::Crypto::CryptFile extension interface types
-CryptFile/fallback/const-c.inc Filter::Crypto::CryptFile extension constants fallback file
-CryptFile/fallback/const-xs.inc Filter::Crypto::CryptFile extension constants fallback file
-CryptFile/lib/Filter/Crypto/CryptFile.pm Filter::Crypto::CryptFile extension Perl module
-Decrypt/Decrypt.xs Filter::Crypto::Decrypt extension external subroutines
-Decrypt/Makefile.PL Filter::Crypto::Decrypt extension makefile writer
-Decrypt/lib/Filter/Crypto/Decrypt.pm Filter::Crypto::Decrypt extension Perl module
-inc/Module/AutoInstall.pm Module::AutoInstall Perl module
-inc/Module/Install.pm Module::Install Perl module
-inc/Module/Install/AutoInstall.pm Module::Install::AutoInstall Perl module
-inc/Module/Install/Base.pm Module::Install::Base Perl module
-inc/Module/Install/Can.pm Module::Install::Can Perl module
-inc/Module/Install/Include.pm Module::Install::Include Perl module
-inc/Module/Install/Makefile.pm Module::Install::Makefile Perl module
-inc/Module/Install/MakeMaker.pm Module::Install::MakeMaker Perl module
-inc/Module/Install/Metadata.pm Module::Install::Metadata Perl module
-inc/Module/Install/PRIVATE.pm Module::Install::PRIVATE Perl module
-inc/Module/Install/Scripts.pm Module::Install::Scripts Perl module
-inc/Module/Install/PRIVATE/Filter/Crypto.pm Module::Install::PRIVATE::Filter::Crypto Perl module
-lib/Filter/Crypto.pm Filter::Crypto Perl module
-lib/PAR/Filter/Crypto.pm PAR::Filter::Crypto Perl module
-script/crypt_file Perl script to encrypt (and decrypt) Perl modules
-t/01_constants.t See if autoloading of constants works
-t/02_function.t See if crypt_file() function (and decryption filter) works
-t/03_script.t See if crypt_file script (and decryption filter) works
-t/04_par.t See if PAR::Filter::Crypto module (and decryption filter) works
-t/05_errstr.t See if $ErrStr variable works
-t/06_pod.t See if POD is OK
-t/cryptfile-leaktest.pl Manually see if crypt_file() function leaks
-t/decrypt-leaktest.pl Manually see if decryption filter leaks
+Artistic The "Artistic License"
+Changes Differences from previous version
+Copying The GNU General Public License
+CryptoCommon-c.inc Filter::Crypto::* extensions common C code
+CryptoCommon-xs.inc Filter::Crypto::* extensions common external subroutines
+INSTALL Detailed installation instructions
+LICENCE The Licence
+Makefile.PL Filter::Crypto makefile writer
+MANIFEST This list of files
+MANIFEST.SKIP Manifest skip specs
+README The Instructions
+ppport.h Perl/Pollution/Portability header
+CryptFile/CryptFile.xs Filter::Crypto::CryptFile extension external subroutines
+CryptFile/Makefile.PL Filter::Crypto::CryptFile extension makefile writer
+CryptFile/typemap Filter::Crypto::CryptFile extension interface types
+CryptFile/fallback/const-c.inc Filter::Crypto::CryptFile extension constants fallback file
+CryptFile/fallback/const-xs.inc Filter::Crypto::CryptFile extension constants fallback file
+CryptFile/lib/Filter/Crypto/CryptFile.pm Filter::Crypto::CryptFile extension Perl module
+Decrypt/Decrypt.xs Filter::Crypto::Decrypt extension external subroutines
+Decrypt/Makefile.PL Filter::Crypto::Decrypt extension makefile writer
+Decrypt/lib/Filter/Crypto/Decrypt.pm Filter::Crypto::Decrypt extension Perl module
+lib/Filter/Crypto.pm Filter::Crypto Perl module
+lib/PAR/Filter/Crypto.pm PAR::Filter::Crypto Perl module
+script/crypt_file Perl script to encrypt (and decrypt) Perl modules
+t/01_imports_01.t See if import options work
+t/01_imports_02.t See if import options work
+t/01_imports_03.t See if import options work
+t/01_imports_04.t See if import options work
+t/02_function.t See if crypt_file() function (and decryption filter) works
+t/03_script.t See if crypt_file script (and decryption filter) works
+t/04_par.t See if PAR::Filter::Crypto module (and decryption filter) works
+t/05_errstr.t See if $ErrStr variable works
+t/06_pod.t See if POD is OK
+t/cryptfile-leaktest.pl Manually see if crypt_file() function leaks
+t/decrypt-leaktest.pl Manually see if decryption filter leaks
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
@@ -0,0 +1,127 @@
+{
+ "abstract" : "Create runnable Perl files encrypted with OpenSSL libcrypto",
+ "author" : [
+ "Steve Hay <shay@cpan.org>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Filter-Crypto",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ],
+ "package" : [
+ "Filter::Crypto::_ConfigureBuild"
+ ]
+ },
+ "optional_features" : {
+ "parfilter" : {
+ "description" : "PAR::Filter support",
+ "prereqs" : {
+ "runtime" : {
+ "recommends" : {
+ "File::Temp" : "0",
+ "PAR::Filter" : "0"
+ }
+ },
+ "test" : {
+ "recommends" : {
+ "Archive::Zip" : "0",
+ "PAR::Filter" : "0"
+ }
+ }
+ }
+ },
+ "podtest" : {
+ "description" : "POD testing",
+ "prereqs" : {
+ "runtime" : {
+ "recommends" : {
+ "Test::Pod" : "1.00"
+ }
+ }
+ }
+ },
+ "tempfile" : {
+ "description" : "crypt_file -e tempfile support",
+ "prereqs" : {
+ "runtime" : {
+ "recommends" : {
+ "File::Temp" : "0"
+ }
+ },
+ "test" : {
+ "recommends" : {
+ "File::Temp" : "0"
+ }
+ }
+ }
+ }
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "Carp" : "0",
+ "Config" : "0",
+ "Cwd" : "0",
+ "ExtUtils::MakeMaker" : "6.66",
+ "Fcntl" : "0",
+ "File::Basename" : "0",
+ "File::Copy" : "0",
+ "File::Spec::Functions" : "0",
+ "Getopt::Long" : "0",
+ "Pod::Usage" : "1.15",
+ "Text::Wrap" : "0",
+ "constant" : "0",
+ "perl" : "5.008001",
+ "strict" : "0",
+ "warnings" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Exporter" : "0",
+ "Fcntl" : "0",
+ "Scalar::Util" : "0",
+ "Text::ParseWords" : "0",
+ "XSLoader" : "0",
+ "perl" : "5.008001"
+ }
+ },
+ "test" : {
+ "requires" : {
+ "Config" : "0",
+ "Cwd" : "0",
+ "File::Copy" : "0",
+ "File::Spec::Functions" : "0",
+ "FindBin" : "0",
+ "Test::More" : "0",
+ "blib" : "0",
+ "perl" : "5.008001",
+ "strict" : "0",
+ "warnings" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "type" : "git",
+ "url" : "https://github.com/steve-m-hay/Filter-Crypto.git"
+ }
+ },
+ "version" : "2.06"
+}
@@ -3,55 +3,67 @@ abstract: 'Create runnable Perl files encrypted with OpenSSL libcrypto'
author:
- 'Steve Hay <shay@cpan.org>'
build_requires:
- ExtUtils::MakeMaker: 6.59
- Test::More: 0
- blib: 0
+ Config: '0'
+ Cwd: '0'
+ ExtUtils::MakeMaker: '0'
+ File::Copy: '0'
+ File::Spec::Functions: '0'
+ FindBin: '0'
+ Test::More: '0'
+ blib: '0'
+ perl: '5.008001'
+ strict: '0'
+ warnings: '0'
configure_requires:
- Carp: 0
- Config: 0
- Cwd: 0
- ExtUtils::MakeMaker: 6.59
- File::Basename: 0
- File::Copy: 0
- File::Find: 0
- File::Path: 0
- File::Spec: 0
- File::Spec::Functions: 0
- FindBin: 0
- Getopt::Long: 0
- Pod::Usage: 1.15
- Text::Wrap: 0
- constant: 0
- parent: 0
- strict: 0
- vars: 0
- warnings: 0
-distribution_type: module
+ Carp: '0'
+ Config: '0'
+ Cwd: '0'
+ ExtUtils::MakeMaker: '6.66'
+ Fcntl: '0'
+ File::Basename: '0'
+ File::Copy: '0'
+ File::Spec::Functions: '0'
+ Getopt::Long: '0'
+ Pod::Usage: '1.15'
+ Text::Wrap: '0'
+ constant: '0'
+ perl: '5.008001'
+ strict: '0'
+ warnings: '0'
dynamic_config: 1
-generated_by: 'Module::Install version 1.06'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Filter-Crypto
no_index:
directory:
- - inc
- t
-recommends:
- File::Temp: 0
- PAR::Filter: 0
+ - inc
+ package:
+ - Filter::Crypto::_ConfigureBuild
+optional_features:
+ parfilter:
+ description: 'PAR::Filter support'
+ recommends:
+ File::Temp: '0'
+ PAR::Filter: '0'
+ podtest:
+ description: 'POD testing'
+ recommends:
+ Test::Pod: '1.00'
+ tempfile:
+ description: 'crypt_file -e tempfile support'
+ recommends:
+ File::Temp: '0'
requires:
- Archive::Zip: 0
- Exporter: 0
- Fcntl: 0
- File::Temp: 0
- PAR::Filter: 0
- Scalar::Util: 0
- Test::Pod: 1.00
- Text::ParseWords: 0
- XSLoader: 0
- perl: 5.6.0
+ Exporter: '0'
+ Fcntl: '0'
+ Scalar::Util: '0'
+ Text::ParseWords: '0'
+ XSLoader: '0'
+ perl: '5.008001'
resources:
- license: http://dev.perl.org/licenses/
-version: 2.03
+ repository: https://github.com/steve-m-hay/Filter-Crypto.git
+version: '2.06'
@@ -7,7 +7,7 @@
# Top-level makefile creation script.
#
# COPYRIGHT
-# Copyright (C) 2004-2009, 2012 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2009, 2012, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -15,162 +15,2239 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
-use inc::Module::Install;
+use ExtUtils::MakeMaker 6.66;
+use ExtUtils::MakeMaker qw(WriteMakefile);
#===============================================================================
# INITIALIZATION
#===============================================================================
-our $VERSION = '1.10';
+our($VERSION, $YEAR);
+
+BEGIN {
+ $VERSION = '1.13';
+ $YEAR = '2004-2009, 2012, 2014';
+}
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+MAIN: {
+ my $cb = Filter::Crypto::_ConfigureBuild->new();
+
+ my @opt_specs = (
+ 'prefix-dir|d=s',
+ 'cipher-config|c=s',
+ 'cipher-name|n=s',
+ 'cipher-mode|m=s',
+ 'pswd|p=s',
+ 'key|k=s',
+ 'rng|r=s',
+ 'key-len|l=i',
+ 'rc2-key-bits=i',
+ 'rc5-rounds=i',
+ 'install-script|i=s',
+ 'build|b=s',
+ 'unsafe-mode|u',
+ 'debug-mode'
+ );
+
+ $cb->process_opts(\@opt_specs);
+
+ $cb->locate_openssl();
+ $cb->configure_cipher();
+
+ my $dir = $cb->query_build();
+
+ if ("@$dir" =~ /Decrypt/o) {
+ $cb->check_perl();
+ }
+
+ my $exe_files = $cb->query_script("@$dir" =~ /CryptFile/o ? 'y' : 'n');
+
+ $cb->setup_env();
+
+ WriteMakefile(
+ NAME => 'Filter::Crypto',
+ ABSTRACT_FROM => 'lib/Filter/Crypto.pm',
+ AUTHOR => 'Steve Hay <shay@cpan.org>',
+ LICENSE => 'perl_5',
+ VERSION_FROM => 'lib/Filter/Crypto.pm',
+
+ META_MERGE => {
+ 'meta-spec' => {
+ version => 2
+ },
+
+ no_index => {
+ package => 'Filter::Crypto::_ConfigureBuild'
+ },
+
+ resources => {
+ repository => {
+ type => 'git',
+ url => 'https://github.com/steve-m-hay/Filter-Crypto.git'
+ }
+ },
+
+ optional_features => {
+ parfilter => {
+ description => 'PAR::Filter support',
+ prereqs => {
+ runtime => {
+ recommends => {
+ 'PAR::Filter' => '0',
+ 'File::Temp' => '0'
+ }
+ },
+
+ test => {
+ recommends => {
+ 'Archive::Zip' => '0',
+ 'PAR::Filter' => '0'
+ }
+ }
+ }
+ },
+
+ tempfile => {
+ description => 'crypt_file -e tempfile support',
+ prereqs => {
+ runtime => {
+ recommends => {
+ 'File::Temp' => '0',
+ }
+ },
+
+ test => {
+ recommends => {
+ 'File::Temp' => '0',
+ }
+ }
+ }
+ },
+
+ podtest => {
+ description => 'POD testing',
+ prereqs => {
+ runtime => {
+ recommends => {
+ 'Test::Pod' => '1.00',
+ }
+ }
+ }
+ }
+ }
+ },
+
+ MIN_PERL_VERSION => '5.008001',
+
+ CONFIGURE_REQUIRES => {
+ 'Carp' => '0',
+ 'Config' => '0',
+ 'Cwd' => '0',
+ 'ExtUtils::MakeMaker' => '6.66',
+ 'Fcntl' => '0',
+ 'File::Basename' => '0',
+ 'File::Copy' => '0',
+ 'File::Spec::Functions' => '0',
+ 'Getopt::Long' => '0',
+ 'Pod::Usage' => '1.15',
+ 'Text::Wrap' => '0',
+ 'constant' => '0',
+ 'perl' => '5.008001',
+ 'strict' => '0',
+ 'warnings' => '0'
+ },
+
+ TEST_REQUIRES => {
+ 'Config' => '0',
+ 'Cwd' => '0',
+ 'File::Copy' => '0',
+ 'File::Spec::Functions' => '0',
+ 'FindBin' => '0',
+ 'Test::More' => '0',
+ 'blib' => '0',
+ 'perl' => '5.008001',
+ 'strict' => '0',
+ 'warnings' => '0'
+ },
+
+ PREREQ_PM => {
+ 'Exporter' => '0',
+ 'Fcntl' => '0',
+ 'Scalar::Util' => '0',
+ 'Text::ParseWords' => '0',
+ 'XSLoader' => '0',
+ 'perl' => '5.008001'
+ },
+
+ DIR => $dir,
+
+ EXE_FILES => $exe_files,
+
+ clean => {
+ FILES => 'CipherConfig.h'
+ },
+
+ dist => {
+ PREOP => 'find $(DISTVNAME) -type d -print|xargs chmod 0755 && ' .
+ 'find $(DISTVNAME) -type f -print|xargs chmod 0644 && ' .
+ 'chmod 0755 $(DISTVNAME)/script/crypt_file',
+ TO_UNIX => 'find $(DISTVNAME) -type f -print|xargs dos2unix'
+ }
+ );
+}
+
+#===============================================================================
+# MAKEMAKER OVERRIDES
+#===============================================================================
+
+# Method to temporarily remove the list of sub-directories when creating the
+# (top-level) "test" target since our sub-directories have no tests of their
+# own. This saves the bother of cd'ing into them and avoids the alarming "No
+# tests defined..." message when running the top-level "test" target. (The
+# sub-directories' Makefiles still have their own "test" targets, though, so
+# anyone manually cd'ing into them and running those "test" targets will get the
+# message about there being no tests.)
+#
+# This method is based on code taken from the MY::test() method in the top-level
+# Makefile.PL script in the Tk distribution (version 804.032).
+
+sub MY::test {
+ my($self, %args) = @_;
+ my $dir = delete $self->{DIR};
+ my $str = $self->MM::test(%args);
+ $self->{DIR} = $dir;
+ return $str;
+}
+
+#===============================================================================
+# PRIVATE CLASS
+#===============================================================================
+
+{
+
+package Filter::Crypto::_ConfigureBuild;
+
+use Carp qw(croak);
+use Config qw(%Config);
+use Cwd qw(abs_path);
+use ExtUtils::MakeMaker qw(prompt);
+use Fcntl;
+use File::Basename qw(basename dirname);
+use File::Copy qw(copy);
+use File::Spec::Functions qw(canonpath catdir catfile curdir
+ file_name_is_absolute path updir);
+use Getopt::Long qw(GetOptions);
+use Pod::Usage qw(pod2usage);
+use Text::Wrap qw(wrap);
+
+use constant CIPHER_NAME_DES => 'DES';
+use constant CIPHER_NAME_DES_EDE => 'DES_EDE';
+use constant CIPHER_NAME_DES_EDE3 => 'DES_EDE3';
+use constant CIPHER_NAME_RC4 => 'RC4';
+use constant CIPHER_NAME_IDEA => 'IDEA';
+use constant CIPHER_NAME_RC2 => 'RC2';
+use constant CIPHER_NAME_DESX => 'DESX';
+use constant CIPHER_NAME_BLOWFISH => 'Blowfish';
+use constant CIPHER_NAME_NULL => 'Null';
+use constant CIPHER_NAME_RC5 => 'RC5';
+use constant CIPHER_NAME_CAST5 => 'CAST5';
+use constant CIPHER_NAME_AES => 'AES';
+
+use constant CIPHER_MODE_ECB => 'ECB';
+use constant CIPHER_MODE_CBC => 'CBC';
+use constant CIPHER_MODE_CFB => 'CFB';
+use constant CIPHER_MODE_OFB => 'OFB';
+
+use constant CIPHER_KEY_GIVEN_PSWD => 1;
+use constant CIPHER_KEY_RANDOM_PSWD => 2;
+use constant CIPHER_KEY_GIVEN => 3;
+use constant CIPHER_KEY_RANDOM => 4;
+
+use constant RAND_OPTION_STR => 'rand';
+use constant RAND_PSWD_LEN => 32;
+
+use constant RNG_PERL_RAND => 'Perl';
+use constant RNG_CRYPT_RANDOM => 'Crypt::Random';
+use constant RNG_MATH_RANDOM => 'Math::Random';
+use constant RNG_OPENSSL_RAND => 'OpenSSL';
+
+use constant CIPHER_CONFIG_FILENAME => 'CipherConfig.h';
+
+use constant BUILD_OPTION_BOTH => 'both';
+use constant BUILD_OPTION_CRYPTFILE => 'CryptFile';
+use constant BUILD_OPTION_DECRYPT => 'Decrypt';
+
+#-------------------------------------------------------------------------------
+# CLASS INITIALIZATION
+#-------------------------------------------------------------------------------
+
+our($VERSION, $YEAR, $Show_Found_Var_Indent);
+
+BEGIN {
+ $VERSION = $main::VERSION;
+ $YEAR = $main::YEAR;
+
+ # Define indentation for show_found_var() method.
+ $Show_Found_Var_Indent = 37;
+
+ # Define protected accessor/mutator methods.
+ foreach my $prop (qw(
+ define inc libs opts
+ prefix_dir inc_dir ver_num ver_str lib_dir lib_name bin_file
+ cipher_name cipher_func cipher_needs_iv key_len rc2_key_bits rc5_rounds
+ pswd key
+ )) {
+ no strict 'refs';
+ *$prop = sub {
+ use strict 'refs';
+ my $self = shift;
+ $self->{$prop} = shift if @_;
+ return $self->{$prop};
+ };
+ }
+}
+
+#-------------------------------------------------------------------------------
+# PUBLIC API
+#-------------------------------------------------------------------------------
+
+sub new {
+ return bless {}, shift;
+}
+
+sub process_opts {
+ my($self, $opt_specs, $with_auto_install) = @_;
+
+ # Allow options to be introduced with a "/" character on Windows, as is
+ # common on those OSes, as well as the default set of characters.
+ if ($self->is_win32()) {
+ Getopt::Long::Configure('prefix_pattern=(--|-|\+|\/)');
+ }
+
+ # Deal with these common options immediately; have the rest stored in %opts.
+ my $opt_def = 0;
+ my %opts = (
+ 'defaults' => sub { $ENV{PERL_MM_USE_DEFAULT} = 1; $opt_def = 1 },
+ 'version' => sub { $self->exit_with_version() },
+ 'help' => sub { $self->exit_with_help() },
+ 'manpage' => sub { $self->exit_with_manpage() }
+ );
+
+ # Make sure that '-v' and '-h' unambiguously mean '--version' and '--help'
+ # respectively, even if other option specs beginning with 'v' or 'h' are
+ # given in @$opt_specs.
+ my @opt_specs = (
+ @$opt_specs,
+ 'defaults',
+ 'version|v',
+ 'help|h|?',
+ 'manpage|doc'
+ );
+
+ GetOptions(\%opts, @opt_specs) or
+ $self->exit_with_usage();
+
+ $self->opts(\%opts);
+}
+
+# This method is based on code taken from the can_run() method in the standard
+# library module IPC::Cmd (version 0.92).
+
+sub can_run {
+ my($self, $cmd) = @_;
+
+ if ($^O eq 'VMS') {
+ require VMS::DCLsym;
+ my $syms = VMS::DCLsym->new();
+ return $cmd if scalar $syms->getsym(uc $cmd);
+ }
+
+ return MM->maybe_command($cmd) if file_name_is_absolute($cmd);
+
+ foreach my $dir (path(), curdir()) {
+ next if !$dir or !-d $dir;
+ my $abs = catfile($dir, $cmd);
+ return $abs if $abs = MM->maybe_command($abs);
+ }
+
+ return;
+}
+
+sub query_script {
+ my($self, $default) = @_;
+
+ my $script_name = 'crypt_file';
+
+ my $install_script = $self->opts()->{'install-script'};
+ if (defined $install_script) {
+ if ($install_script =~ /^(?:y|n)$/io) {
+ $self->show_found_var(
+ 'Using specified script option', $install_script
+ );
+ }
+ else {
+ $self->exit_with_error(3,
+ "Invalid 'install_script' option value '%s'", $install_script
+ );
+ }
+ }
+ else {
+ my $question = "Do you want to install '$script_name'?";
+ $default = 'y' unless defined $default;
+ $install_script = $self->prompt_yes_no($question, $default);
+ }
+ print "\n";
+
+ if ($install_script) {
+ return [ catfile('script', $script_name) ];
+ }
+ else {
+ return [];
+ }
+}
+
+# Method to store the build options in this process' environment so that they
+# are available to the sub-directories' Makefile.PLs when they are run. Note
+# that ExtUtils::MakeMaker's PASTHRU macro is not good enough because that only
+# passes things through when "make Makefile" is run, which is too late for the
+# processing of the LIBS option that Makefile.PL itself handles.
+
+sub setup_env {
+ my $self = shift;
+
+ $ENV{__SHAY_PRIVATE_DEFINE} = $self->define();
+ $ENV{__SHAY_PRIVATE_INC} = $self->inc();
+ $ENV{__SHAY_PRIVATE_LIBS} = $self->libs();
+}
+
+# Method to check the perl being used isn't a "debug" mode build, unless
+# Makefile.PL was invoked with the "--debug-mode" command-line option, in which
+# case it is okay.
+# Only check whether the DEBUGGING symbol is defined in perl's C compiler flags
+# here. This is sufficient to catch all normal cases. Fuller checks are
+# performed in Decrypt.xs's "BOOT" code (the check is only relevant when the
+# Decrypt component is built).
+
+sub check_perl {
+ my $self = shift;
+
+ return if exists $self->opts()->{'debug-mode'};
+
+ if ($Config{ccflags} =~ /(?:^|\s)-DDEBUGGING(?:\s|$)/o) {
+ $self->exit_with_error(134,
+ 'OS unsupported: The "Decrypt" component requires a "release" ' .
+ 'mode build of perl (i.e. one built without DEBUGGING)'
+ );
+ }
+}
+
+sub locate_openssl {
+ my $self = shift;
+
+ print "\n";
+
+ $self->query_prefix_dir();
+ print "\n";
+
+ $self->locate_inc_dir();
+ $self->set_inc();
+
+ $self->determine_ver_num();
+ $self->set_define();
+
+ $self->locate_lib_dir_and_file();
+ $self->set_libs();
+
+ $self->locate_bin_file();
+ print "\n";
+}
+
+sub configure_cipher {
+ my $self = shift;
+
+ my $cipher_config = $self->opts()->{'cipher-config'};
+ if (defined $cipher_config) {
+ if (-f $cipher_config) {
+ $self->show_found_var(
+ 'Using specified configuration file', $cipher_config
+ );
+ $self->copy_cipher_config($cipher_config);
+ }
+ else {
+ $self->exit_with_error(100,
+ "No such configuration file '%s'", $cipher_config
+ );
+ }
+ }
+ else {
+ $self->query_cipher_name();
+
+ my $lc_cipher_name = lc $self->cipher_name();
+ my $cipher_config_method = "configure_${lc_cipher_name}_cipher";
+ $self->$cipher_config_method();
+
+ $self->query_pswd_or_key();
+
+ $self->write_cipher_config();
+ }
+}
+
+sub query_build {
+ my $self = shift;
+
+ my @build_options = (
+ [ BUILD_OPTION_BOTH, 'Build both components' ],
+ [ BUILD_OPTION_CRYPTFILE, 'Build CryptFile component only' ],
+ [ BUILD_OPTION_DECRYPT, 'Build Decrypt component only' ]
+ );
+
+ my $build = $self->opts()->{'build'};
+ if (defined $build) {
+ my %build_options = map { $_->[0] => 1 } @build_options;
+ if (exists $build_options{$build}) {
+ $self->show_found_var('Using specified build option', $build);
+ }
+ else {
+ $self->exit_with_error(101,
+ "Invalid 'build' option value '%s'", $build
+ );
+ }
+ }
+ else {
+ my $message = 'Build options:';
+ my $question = 'Which component(s) do you want to build?';
+ my $default = BUILD_OPTION_BOTH;
+
+ $build = $self->prompt_list(
+ $message, \@build_options, $question, $default
+ );
+ }
+ print "\n";
+
+ if ($build eq BUILD_OPTION_BOTH) {
+ return [ BUILD_OPTION_CRYPTFILE, BUILD_OPTION_DECRYPT ];
+ }
+ else {
+ return [ $build ];
+ }
+}
+
+#-------------------------------------------------------------------------------
+# PROTECTED API
+#-------------------------------------------------------------------------------
+
+sub is_win32 {
+ return $^O eq 'MSWin32';
+}
+
+sub prompt_yes_no {
+ my($self, $question, $default) = @_;
+
+ my $answer = $self->prompt_validate(
+ -question => $question,
+ -default => $default,
+ -validate => sub { $_[0] =~ /^(?:y(?:es)?|no?)$/io }
+ );
+
+ return $answer =~ /^y/io ? 1 : 0;
+}
+
+sub prompt_dir {
+ my($self, $question, $default) = @_;
+
+ my $dir = $self->prompt_validate(
+ -question => $question,
+ -default => $default,
+ -validate => sub { -d $_[0] },
+ -errmsg => 'No such directory'
+ );
+
+ return canonpath(abs_path($dir));
+}
+
+sub prompt_list {
+ my($self, $message, $options, $question, $default) = @_;
+
+ my $num_options = scalar @$options;
+ my $len = length $num_options;
+
+ my %options = map { $_->[0] => 1 } @$options;
+ my $num_unique_options = scalar keys %options;
+ if ($num_unique_options != $num_options) {
+ $self->exit_with_error(4, 'Options in list are not unique');
+ }
+
+ my $default_num = 0;
+ for (my $i = 1; $i <= $num_options; $i++) {
+ $message .= sprintf "\n [%${len}d] %s", $i, $options->[$i - 1][1];
+ $default_num = $i if $options->[$i - 1][0] eq $default;
+ }
+
+ if ($default_num == 0) {
+ $self->exit_with_error(5, "Invalid default response '%s'", $default);
+ }
+
+ my $answer_num = $self->prompt_validate(
+ -message => $message,
+ -question => $question,
+ -default => $default_num,
+ -validate => sub {
+ $_[0] =~ /^[1-9](?:\d+)?$/o and $_[0] <= $num_options
+ }
+ );
+
+ return $options->[$answer_num - 1][0];
+}
+
{
- no warnings 'once';
- our $YEAR = '2004-2009, 2012';
+ my %defaults = (
+ -question => '?',
+ -default => '',
+ -validate => sub { 1 },
+ -errmsg => 'Invalid response'
+ );
+
+ sub prompt_validate {
+ my $self = shift;
+ my %args = (%defaults, @_);
+
+ if (exists $args{-message}) {
+ print wrap('', '', $args{-message}), "\n";
+ }
+
+ my $input;
+ until (defined $input) {
+ $input = prompt($args{-question}, $args{-default});
+ unless ($args{-validate}->($input)) {
+ if ($self->use_default_response()) {
+ $self->exit_with_error(7,
+ "Invalid default response '%s'", $args{-default}
+ );
+ }
+ else {
+ print wrap('', '', $args{-errmsg}), "\n";
+ $input = undef;
+ }
+ }
+ }
+
+ return $input;
+ }
+}
+
+sub show_found_var {
+ my($self, $msg, $var) = @_;
+ local $Text::Wrap::break = qr{\s|(?<=[\\\\/]).{0}}o;
+ print wrap('', ' ' x $Show_Found_Var_Indent,
+ "$msg " . '.' x ($Show_Found_Var_Indent - length($msg) - 2) . " $var"
+ ), "\n";
+}
+
+sub exit_with_version {
+ my $self = shift;
+
+ printf "This is %s %s.\n\n", basename($0), $main::VERSION;
+
+ print "Copyright (C) $YEAR Steve Hay. All rights reserved.\n\n";
+
+ print wrap('', '',
+ "This script is free software; you can redistribute it and/or modify " .
+ "it under the same terms as Perl itself, i.e. under the terms of " .
+ "either the GNU General Public License or the Artistic License, as " .
+ "specified in the LICENCE file.\n\n"
+ );
+
+ exit 1;
+}
+
+sub exit_with_help {
+ my $self = shift;
+ pod2usage(
+ -exitval => 1,
+ -verbose => 1
+ );
+}
+
+sub exit_with_manpage {
+ my $self = shift;
+ pod2usage(
+ -exitval => 1,
+ -verbose => 2
+ );
+}
+
+sub exit_with_usage {
+ my $self = shift;
+ pod2usage(
+ -exitval => 2,
+ -verbose => 0
+ );
+}
+
+sub exit_with_error {
+ my($self, $num, $msg) = splice @_, 0, 3;
+ $msg = sprintf $msg, @_ if @_;
+ # Load Carp::Heavy now, otherwise (before Perl 5.8.7) croak() clobbers $!
+ # when loading it.
+ require Carp::Heavy;
+ $! = $num;
+ croak("Error ($num): $msg");
+}
+
+# This method is based on code taken from the prompt() function in the standard
+# library module ExtUtils::MakeMaker (version 6.92).
+
+sub use_default_response {
+ my $self = shift;
+ return($ENV{PERL_MM_USE_DEFAULT} or (not $self->isa_tty() and eof STDIN));
+}
+
+# This method is based on code taken from the prompt() function in the standard
+# library module ExtUtils::MakeMaker (version 6.92).
+
+sub isa_tty {
+ my $self = shift;
+ return(-t STDIN and (-t STDOUT or not (-f STDOUT or -c STDOUT)));
+}
+
+sub query_prefix_dir {
+ my $self = shift;
+
+ my $prefix_dir = $self->opts()->{'prefix-dir'};
+ if (defined $prefix_dir) {
+ $prefix_dir = canonpath(abs_path($prefix_dir));
+ if (-d $prefix_dir) {
+ $self->show_found_var(
+ 'Using specified prefix directory', $prefix_dir
+ );
+ }
+ else {
+ $self->exit_with_error(102,
+ "No such prefix directory '%s'", $prefix_dir
+ );
+ }
+ }
+ else {
+ # Look for the main binary executable "openssl" and use the parent
+ # directory of where that is located; otherwise use the default prefix
+ # directory as specified in the latest OpenSSL's own INSTALL file if it
+ # exists.
+ my $bin_file;
+ if ($bin_file = $self->can_run('openssl')) {
+ if ($self->is_win32()) {
+ # Find out (if we can) which platform this binary was built for.
+ # This information is normally contained in the output of the
+ # binary's "version -a" command, labelled "platform: ".
+ my $bin_cmd = "$bin_file version -a 2>&1";
+
+ my $bin_output = `$bin_cmd`;
+ my $bin_rc = $? >> 8;
+
+ if ($bin_rc) {
+ $self->exit_with_error(133,
+ "Could not get OpenSSL version information " .
+ "(%d):\n%s", $bin_rc, $bin_output
+ );
+ }
+
+ if ((my $platform) = $bin_output =~ /platform: ?(.*)$/imo) {
+ # If we have found a Cygwin binary then we had better not
+ # try to use it with our Win32 perl.
+ if ($platform =~ /^Cygwin/io) {
+ warn("Warning: Ignoring Cygwin OpenSSL binary " .
+ "'$bin_file' on Win32\n");
+ $bin_file = undef;
+ }
+ }
+ }
+ }
+
+ my $default;
+ if (defined $bin_file) {
+ # The binaries are normally located in a sub-directory (bin/,
+ # out32/, out32dll/, out32.dbg/, out32dll.dbg or out/) of the prefix
+ # directory. See locate_bin_file().
+ my $bin_dir = dirname($bin_file);
+ $default = canonpath(abs_path(catdir($bin_dir, updir())));
+ }
+ else {
+ $default = $self->is_win32() ? 'C:\\openssl' : '/usr/local/ssl';
+ unless (-d $default) {
+ if ($self->use_default_response()) {
+ $self->exit_with_error(132,
+ 'OS unsupported: No OpenSSL/SSLeay directory found'
+ );
+ }
+ else {
+ $default = '';
+ }
+ }
+ }
+
+ my $question = 'Where is your OpenSSL?';
+
+ $prefix_dir = $self->prompt_dir($question, $default);
+ }
+
+ $self->prefix_dir($prefix_dir)
+}
+
+sub locate_inc_dir {
+ my $self = shift;
+
+ # NOTE: We support finding the header files of older OpenSSLs and SSLeays
+ # than we support so that we can report on the failed minimum requirement.
+
+ # The headers are normally located in the include/ sub-directory of the
+ # prefix directory.
+ # However, we may be working with a build directory rather than an
+ # installation directory, in which case the header files will be in a
+ # different sub-directory on "native" Windows platforms, in this case inc32/
+ # (0.9.0 onwards) or out/ (up to and including 0.8.1b), or even outinc/ for
+ # MinGW builds. Beware of version 0.6.0 build directories, which contain an
+ # include/ sub-directory containing "Shortcuts" to the real header files in
+ # the out/ sub-directory. Check for the presence of the "cyrypto.h" header
+ # file to be sure we find the correct sub-directory. The header files are
+ # now located in the openssl/ sub-directory of the include directory (0.9.3
+ # onwards), but were located in the include directory itself (up to and
+ # including 0.8.1b).
+ my $prefix_dir = $self->prefix_dir();
+ my($dir, $inc_dir);
+ if (-d ($dir = catdir($prefix_dir, 'include')) and
+ (-f catfile($dir, 'openssl', 'crypto.h') or
+ -f catfile($dir, 'crypto.h')))
+ {
+ $inc_dir = $dir;
+ }
+ elsif ($self->is_win32()) {
+ if (-d ($dir = catdir($prefix_dir, 'inc32')) and
+ (-f catfile($dir, 'openssl', 'crypto.h') or
+ -f catfile($dir, 'crypto.h')))
+ {
+ $inc_dir = $dir;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'outinc')) and
+ (-f catfile($dir, 'openssl', 'crypto.h') or
+ -f catfile($dir, 'crypto.h')))
+ {
+ $inc_dir = $dir;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'out')) and
+ -f catfile($dir, 'crypto.h'))
+ {
+ $inc_dir = $dir;
+ }
+ }
+
+ if (defined $inc_dir) {
+ $self->show_found_var('Found include directory', $inc_dir);
+ $self->inc_dir($inc_dir)
+ }
+ else {
+ $self->exit_with_error(103,
+ 'No OpenSSL/SSLeay include directory found'
+ );
+ }
+}
+
+sub set_inc {
+ my $self = shift;
+
+ my $inc_dir = $self->inc_dir();
+ $self->inc("-I$inc_dir");
+}
+
+sub determine_ver_num {
+ my $self = shift;
+
+ # NOTE: We support finding the version number of older OpenSSLs and SSLeays
+ # than we support so that we can report on the failed minimum requirement.
+
+ # The header files are now located in the openssl/ sub-directory of the
+ # include directory (0.9.3 onwards), but were located in the include
+ # directory itself (up to and including 0.8.1b).
+ my $inc_dir = $self->inc_dir();
+ my($dir, $inc_files_dir);
+ if (-d ($dir = catdir($inc_dir, 'openssl'))) {
+ $inc_files_dir = $dir;
+ }
+ else {
+ $inc_files_dir = $inc_dir;
+ }
+
+ # The version number is now specified by an OPENSSL_VERSION_NUMBER #define
+ # in the opensslv.h header file (0.9.2 onwards). That #define was in the
+ # crypto.h header file (0.9.1s), and was called SSLEAY_VERSION_NUMBER (from
+ # 0.6.0 to 0.9.0b inclusive). Earlier versions do not seem to have a
+ # version number defined in this way, but we do not support anything earlier
+ # anyway. The version number is specified as a hexadecimal integer of the
+ # form MNNFFPPS (major, minor, fix, patch, status [0 for dev, 1 to 14 for
+ # betas, and f for release) (0.9.5a onwards, but with the highest bit set in
+ # the patch byte for the 0.9.5s), or of the form MNNFFRBB (major, minor,
+ # fix, release, patch or beta) (0.9.3s, 0.9.4s and 0.9.5), or of the form
+ # MNFP (major, minor, fix, patch) (up to and including 0.9.2b).
+ my($file, $ver_file);
+ if (-f ($file = catfile($inc_files_dir, 'opensslv.h'))) {
+ $ver_file = $file;
+ }
+ elsif (-f ($file = catfile($inc_files_dir, 'crypto.h'))) {
+ $ver_file = $file;
+ }
+ else {
+ $self->exit_with_error(104,
+ 'No OpenSSL/SSLeay version number header file found'
+ );
+ }
+
+ my $ver_define;
+ if (open my $ver_fh, '<', $ver_file) {
+ while (<$ver_fh>) {
+ if (/^\#define\s+(?:OPENSSL|SSLEAY)_VERSION_NUMBER\s+
+ 0x([0-9a-f]+)/iox)
+ {
+ $ver_define = $1;
+ last;
+ }
+ }
+ close $ver_fh;
+ }
+ else {
+ $self->exit_with_error(105,
+ "Could not open version number header file '%s' for reading: %s",
+ $ver_file, $!
+ );
+ }
+
+ my($major, $minor, $fix, $patch, $status_str);
+ if (defined $ver_define) {
+ if (length $ver_define == 8 and
+ $ver_define =~ /^([0-9a-f])([0-9a-f]{2})([0-9a-f]{2})/io)
+ {
+ ($major, $minor, $fix) = map { hex } ($1, $2, $3);
+
+ my $mmf_ver_num = $major * 10000 + $minor * 100 + $fix;
+
+ if ( $mmf_ver_num > 905 or
+ ($mmf_ver_num == 905 and $ver_define !~ /100$/o))
+ {
+ my $status_num;
+ ($patch, $status_num) = map { hex }
+ $ver_define =~ /([0-9a-f]{2})([0-9a-f])$/io;
+
+ $patch = 0xff & ($patch & ~0x80) if $mmf_ver_num == 905;
+
+ if ($status_num == 0) {
+ $status_str = '-dev';
+ }
+ elsif ($status_num < 0xf) {
+ $status_str = '-beta' . (1 .. 0xe)[$status_num - 1];
+ }
+ else {
+ $status_str = '';
+ }
+ }
+ else {
+ my($release, $patch_or_beta) = map { hex }
+ $ver_define =~ /([0-9a-f])([0-9a-f]{2})$/io;
+
+ if ($release == 0) {
+ $patch = 0;
+ if ($patch_or_beta == 0) {
+ $status_str = '-dev';
+ }
+ else {
+ $status_str = '-beta' . (1 .. 0xff)[$patch_or_beta - 1];
+ }
+ }
+ else {
+ $patch = $patch_or_beta;
+ $status_str = '';
+ }
+ }
+ }
+ elsif (length $ver_define == 4 and
+ $ver_define =~ /^([0-9a-f])([0-9a-f])([0-9a-f])([0-9a-f])$/io)
+ {
+ ($major, $minor, $fix, $patch) = map { hex } ($1, $2, $3, $4);
+ $status_str = '';
+ }
+ else {
+ $self->exit_with_error(106,
+ 'Unrecognized OpenSSL/SSLeay version number found (%s)',
+ $ver_define
+ );
+ }
+ }
+ else {
+ $self->exit_with_error(107, 'No OpenSSL/SSLeay version number found');
+ }
+
+ my $ver_num = $major * 1000000 + $minor * 10000 + $fix * 100 + $patch;
+ my $ver_str = "$major.$minor.$fix";
+ $ver_str .= ('', 'a' .. 'z')[$patch];
+ $ver_str .= $status_str;
+
+ my $package = $ver_num >= 90100 ? 'OpenSSL' : 'SSLeay';
+
+ if ($major == 0 and ($minor < 9 or ($minor == 9 and ($fix < 6 or
+ ($fix == 6 and $patch < 11) or ($fix == 7 and $patch < 3)))))
+ {
+ $self->exit_with_error(135,
+ 'OS unsupported: OpenSSL version 0.9.6k or 0.9.7c or higher ' .
+ 'required. This is only %s version %s', $package, $ver_str
+ );
+ }
+
+ $self->show_found_var('Found OpenSSL version', $ver_str);
+ $self->ver_str($ver_str);
+ $self->ver_num($ver_num);
+}
+
+sub set_define {
+ my $self = shift;
+
+ my $ver_num = $self->ver_num();
+ my $unsafe_mode = exists $self->opts()->{'unsafe-mode'};
+ my $debug_mode = exists $self->opts()->{'debug-mode'};
+
+ my $define = "-DFILTER_CRYPTO_OPENSSL_VERSION=$ver_num";
+ $define .= ' -DFILTER_CRYPTO_UNSAFE_MODE' if $unsafe_mode;
+ $define .= ' -DFILTER_CRYPTO_DEBUG_MODE' if $debug_mode;
+
+ $self->define($define);
+}
+
+sub locate_lib_dir_and_file {
+ my $self = shift;
+
+ # The libraries are normally located in the lib/ sub-directory of the prefix
+ # directory, but may be in the lib64/ sub-directory on some 64-bit systems,
+ # or in the lib/amd64/ or lib/sparcv9/ sub-directory on 64-bit Solaris Intel
+ # or 64-bit Solaris Sparc respectively. Some 64-bit systems may have lib/
+ # sub-directories as well, so check in lib64/ etc. first, but only check for
+ # 64-bit libraries if we are using a 64-bit perl. Under Debian Multiarch
+ # (e.g. Ubuntu >= 11.04) the libraries are migrated to lib/i386-linux-gnu/
+ # and lib/x86_64-linux-gnu/ sub-directories.
+ # Again, build directories on "native" Windows platforms may have the files
+ # in a different sub-directory, in this case out32/, out32dll/, out32.dbg/
+ # or out32dll.dbg/ (depending on whether static or dynamic libraries were
+ # built and whether they were built in release or debug mode).
+ # The Win32 OpenSSL Installation produced by Shining Light Productions
+ # installs its libraries into lib/VC (dynamic libraries), lib/VC/static
+ # (static libraries) or lib/MinGW.
+ my $prefix_dir = $self->prefix_dir();
+ my($dir, $lib_dir, $lib_file, $lib_name);
+ if ($self->is_win32()) {
+ if (-d ($dir = catdir($prefix_dir, 'out32')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'out32dll')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'out32.dbg')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'out32dll.dbg')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif ($Config{cc} =~ /cl/io and
+ -d ($dir = catdir($prefix_dir, 'lib', 'VC', 'static')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif ($Config{cc} =~ /cl/io and
+ -d ($dir = catdir($prefix_dir, 'lib', 'VC')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif ($Config{cc} =~ /gcc/io and
+ -d ($dir = catdir($prefix_dir, 'lib', 'MinGW')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ }
+ if (not defined $lib_dir) {
+ if (defined $Config{use64bitint} and
+ $Config{use64bitint} eq 'define' and
+ -d ($dir = catdir($prefix_dir, 'lib64')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif (defined $Config{use64bitint} and
+ $Config{use64bitint} eq 'define' and
+ -d ($dir = catdir($prefix_dir, 'lib', 'amd64')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif (defined $Config{use64bitint} and
+ $Config{use64bitint} eq 'define' and
+ -d ($dir = catdir($prefix_dir, 'lib', 'sparcv9')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif (defined $Config{use64bitint} and
+ $Config{use64bitint} eq 'define' and
+ -d ($dir = catdir($prefix_dir, 'lib', 'x86_64-linux-gnu')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'lib', 'i386-linux-gnu')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'lib')) and
+ ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
+ {
+ $lib_dir = $dir;
+ }
+ }
+
+ if (defined $lib_dir) {
+ $self->show_found_var('Found crypto library', $lib_file);
+ $self->lib_dir($lib_dir);
+ $self->lib_name($lib_name);
+ }
+ else {
+ $self->exit_with_error(109, 'No OpenSSL crypto library found');
+ }
+}
+
+sub probe_for_lib_file {
+ my $self = shift;
+ my $candidate_lib_dir = shift;
+
+ # The libraries on UNIX-type platforms (which includes Cygwin) are called
+ # libssl.a (which contains the SSL and TLS implmentations) and libcrypto.a
+ # (which contains the ciphers, digests, etc) and are specified as -lssl and
+ # -lcrypto respectively. Solaris 10 discourages static linking and Solaris
+ # 11 doesn't even ship static libraries for OpenSSL, so libcrypto.so must be
+ # used instead where that exists in place of libcrypto.a.
+ # On "native" Windows platforms built with Visual C++ (cl) or Borland C++
+ # (bcc32) they are called ssleay32.lib and libeay32.lib and are specified as
+ # -lssleay32 and -llibeay32.
+ # It is also possible to produce "native" Windows builds (i.e. binaries and
+ # libraries that are linked against the Microsoft C RTL msvcrt.dll rather
+ # than Cygwin's POSIX C RTL cygwin1.dll) via MinGW/MinGW-w64 (gcc). In that
+ # case, the OpenSSL libraries are called either libssl.a and libcrypto.a
+ # (for static builds) or libssl32.a and libeay32.a [sic] (for dynamic
+ # builds). They are specified as on UNIX-type platforms, as described in
+ # the ExtUtils::Liblist manpage.
+ # The Win32 OpenSSL Installation produced by Shining Light Productions names
+ # its libraries differently. The Visual C++ libraries are named as normal
+ # but with a MD, MDd, MT or MTd suffix just before the .lib extension (e.g.
+ # libeay32MD.lib), depending on whether they were built with the -MD or -MT
+ # compiler option (of which only the former is supported by Perl) and
+ # whether they were built in release or debug mode. The MinGW libraries are
+ # only provided as dynamic release build libraries, and are named similarly
+ # to the default names of Visual C++ libraries, namely ssleay32.a and
+ # libeay32.a.
+ my($file, $lib_file, $lib_name);
+ if ($self->is_win32()) {
+ if ($Config{cc} =~ /gcc/io) {
+ if (-f ($file = catfile($candidate_lib_dir, 'libcrypto.a'))) {
+ $lib_file = $file;
+ $lib_name = 'crypto';
+ }
+ elsif (-f ($file = catfile($candidate_lib_dir, 'libeay32.a'))) {
+ $lib_file = $file;
+ $lib_name = 'eay32';
+ }
+ }
+ else {
+ if (-f ($file = catfile($candidate_lib_dir, 'libeay32.lib'))) {
+ $lib_file = $file;
+ $lib_name = 'libeay32';
+ }
+ elsif ($Config{cc} =~ /cl/io and
+ -f ($file = catfile($candidate_lib_dir, 'libeay32MD.lib')))
+ {
+ $lib_file = $file;
+ $lib_name = 'libeay32MD';
+ }
+ elsif ($Config{cc} =~ /cl/io and
+ -f ($file = catfile($candidate_lib_dir, 'libeay32MDd.lib')))
+ {
+ $lib_file = $file;
+ $lib_name = 'libeay32MDd';
+ }
+ }
+ }
+ else {
+ if (-f ($file = catfile($candidate_lib_dir, 'libcrypto.a'))) {
+ $lib_file = $file;
+ $lib_name = 'crypto';
+ }
+ elsif (-f ($file = catfile($candidate_lib_dir, 'libcrypto.so'))) {
+ $lib_file = $file;
+ $lib_name = 'crypto';
+ }
+ elsif (-f ($file = catfile($candidate_lib_dir, 'libcrypto.dylib'))) {
+ $lib_file = $file;
+ $lib_name = 'crypto';
+ }
+ }
+
+ return $lib_file ? ($lib_file, $lib_name) : ();
+}
+
+sub set_libs {
+ my $self = shift;
+
+ my $lib_dir = $self->lib_dir();
+ my $lib_name = $self->lib_name();
+ $self->libs("-L$lib_dir -l$lib_name");
+}
+
+sub locate_bin_file {
+ my $self = shift;
+
+ # The binaries are normally located in the bin/ sub-directory of the prefix
+ # directory.
+ # Again, build directories on "native" Windows platforms may have the files
+ # in a different sub-directory, in this case out32/, out32dll/, out32.dbg/
+ # or out32dll.dbg/ (depending on whether static or dynamic libraries were
+ # built and whether they were built in release or debug mode).
+ my $prefix_dir = $self->prefix_dir();
+ my($dir, $bin_file);
+ my $found = 0;
+ if (-d ($dir = catdir($prefix_dir, 'bin')) and
+ defined($bin_file = $self->probe_for_bin_file($dir)))
+ {
+ $found = 1;
+ }
+ elsif ($self->is_win32()) {
+ if (-d ($dir = catdir($prefix_dir, 'out32')) and
+ defined($bin_file = $self->probe_for_bin_file($dir)))
+ {
+ $found = 1;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'out32dll')) and
+ defined($bin_file = $self->probe_for_bin_file($dir)))
+ {
+ $found = 1;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'out32.dbg')) and
+ defined($bin_file = $self->probe_for_bin_file($dir)))
+ {
+ $found = 1;
+ }
+ elsif (-d ($dir = catdir($prefix_dir, 'out32dll.dbg')) and
+ defined($bin_file = $self->probe_for_bin_file($dir)))
+ {
+ $found = 1;
+ }
+ }
+
+ if ($found) {
+ $self->show_found_var('Found binary executable', $bin_file);
+ $self->bin_file($bin_file)
+ }
+ else {
+ $self->exit_with_error(111, 'No OpenSSL binary executable found');
+ }
+}
+
+sub probe_for_bin_file {
+ my $self = shift;
+ my $candidate_bin_dir = shift;
+
+ # The main binary executable is called "openssl".
+ my($file, $bin_file);
+ if (-f ($file = catfile($candidate_bin_dir, "openssl$Config{_exe}"))) {
+ $bin_file = $file;
+ }
+
+ return $bin_file;
+}
+
+sub query_cipher_name {
+ my $self = shift;
+
+ my $ver_num = $self->ver_num();
+
+ # Find out (as best as we can) which ciphers, if any, have been disabled in
+ # the particular crypto library that we are using. Ciphers can be disabled
+ # at build time via "-DOPENSSL_NO_<cipher_name>" (or "-DNO_<cipher_name>"
+ # before 0.9.7), where <cipher_name> can be one of: "DES", "RC4", "IDEA",
+ # "RC2", "BF", "RC5", "CAST" or "AES". This information is normally
+ # contained in the output of the main binary executable's "version -a"
+ # command, labelled "compiler: " and not always on a line of its own.
+ my $bin_file = $self->bin_file();
+ my $bin_cmd = "$bin_file version -a 2>&1";
+
+ my $bin_output = `$bin_cmd`;
+ my $bin_rc = $? >> 8;
+
+ if ($bin_rc) {
+ $self->exit_with_error(112,
+ "Could not get OpenSSL version information (%d):\n%s",
+ $bin_rc, $bin_output
+ );
+ }
+
+ my %disabled = ();
+ if ((my $compiler) = $bin_output =~ /compiler: ?(.*)$/imo) {
+ %disabled = map { $_ => 1 }
+ $compiler =~ m|[-/]D ?"?(?:OPENSSL_)?NO_(\w+)"?|go;
+ }
+
+ my @cipher_names = ();
+
+ if (not exists $disabled{DES}) {
+ push @cipher_names, (
+ [ CIPHER_NAME_DES, 'DES block cipher' ],
+ [ CIPHER_NAME_DES_EDE, 'Two key triple DES block cipher' ],
+ [ CIPHER_NAME_DES_EDE3, 'Three key triple DES block cipher' ],
+ [ CIPHER_NAME_DESX, 'DESX block cipher' ]
+ );
+ }
+
+ if (not exists $disabled{RC4}) {
+ push @cipher_names, (
+ [ CIPHER_NAME_RC4, 'RC4 stream cipher' ]
+ );
+ }
+
+ if (not exists $disabled{IDEA}) {
+ push @cipher_names, (
+ [ CIPHER_NAME_IDEA, 'IDEA block cipher' ]
+ );
+ }
+
+ if (not exists $disabled{RC2}) {
+ push @cipher_names, (
+ [ CIPHER_NAME_RC2, 'RC2 block cipher' ]
+ );
+ }
+
+ if (not exists $disabled{BF}) {
+ push @cipher_names, (
+ [ CIPHER_NAME_BLOWFISH, 'Blowfish block cipher' ]
+ );
+ }
+
+ push @cipher_names, (
+ [ CIPHER_NAME_NULL, 'Null cipher' ]
+ );
+
+ if (not exists $disabled{RC5}) {
+ push @cipher_names, (
+ [ CIPHER_NAME_RC5, 'RC5 block cipher' ]
+ );
+ }
+
+ if (not exists $disabled{CAST}) {
+ push @cipher_names, (
+ [ CIPHER_NAME_CAST5, 'CAST5 block cipher' ]
+ );
+ }
+
+ # The AES cipher was added in OpenSSL 0.9.7.
+ if (not exists $disabled{AES} and $ver_num >= 90700) {
+ push @cipher_names, (
+ [ CIPHER_NAME_AES, 'AES block cipher' ]
+ );
+ }
+
+ my $cipher_name = $self->opts()->{'cipher-name'};
+ if (defined $cipher_name) {
+ my %lc_cipher_names = map { lc $_->[0] => 1 } @cipher_names;
+ if (exists $lc_cipher_names{lc $cipher_name}) {
+ $self->show_found_var('Using specified cipher name', $cipher_name);
+ }
+ else {
+ $self->exit_with_error(113,
+ "No such cipher name '%s'", $cipher_name
+ );
+ }
+ }
+ else {
+ my $message = 'Cipher algorithms available:';
+ my $question = 'Which cipher algorithm do you want to use?';
+
+ my $default;
+ if (not exists $disabled{DES} and $ver_num < 90700) {
+ $default = CIPHER_NAME_DES_EDE3;
+ }
+ elsif (not exists $disabled{AES} and $ver_num >= 90700) {
+ $default = CIPHER_NAME_AES;
+ }
+ else {
+ $default = $cipher_names[$#cipher_names][0];
+ }
+
+ $cipher_name = $self->prompt_list(
+ $message, \@cipher_names, $question, $default
+ );
+ }
+ print "\n";
+
+ $self->cipher_name($cipher_name);
+}
+
+sub query_cipher_mode {
+ my $self = shift;
+
+ my @cipher_modes = (
+ [ CIPHER_MODE_ECB, 'ECB (Electronic Codebook Mode)' ],
+ [ CIPHER_MODE_CBC, 'CBC (Cipher Block Chaining Mode)' ],
+ [ CIPHER_MODE_CFB, 'CFB (64-Bit Cipher Feedback Mode)' ],
+ [ CIPHER_MODE_OFB, 'OFB (64-Bit Output Feedback Mode)' ]
+ );
+
+ my $cipher_mode = $self->opts()->{'cipher-mode'};
+ if (defined $cipher_mode) {
+ my %lc_cipher_modes = map { lc $_->[0] => $_->[0] } @cipher_modes;
+ if (exists $lc_cipher_modes{lc $cipher_mode}) {
+ $self->show_found_var('Using specified cipher mode', $cipher_mode);
+ $cipher_mode = $lc_cipher_modes{lc $cipher_mode};
+ }
+ else {
+ $self->exit_with_error(114,
+ "No such cipher mode '%s'", $cipher_mode
+ );
+ }
+ }
+ else {
+ my $message = 'Modes of operation available:';
+ my $question = 'Which mode of operation do you want to use?';
+ my $default = CIPHER_MODE_CBC;
+
+ $cipher_mode = $self->prompt_list(
+ $message, \@cipher_modes, $question, $default
+ );
+ }
+ print "\n";
+
+ return $cipher_mode;
+}
+
+sub query_key_len {
+ my $self = shift;
+ my %args = @_;
+
+ my $validate;
+ if (exists $args{-fixed}) {
+ $validate = sub { $_[0] eq $args{-fixed} };
+ }
+ elsif (exists $args{-valid}) {
+ my %valid = map { $_ => 1 } @{$args{-valid}};
+ $validate = sub { exists $valid{$_[0]} };
+ }
+ else {
+ my $int_pat = qr/^(?:0|[1-9](?:\d+)?)$/o;
+ # Minimum key size is clearly 0 bytes if it is not otherwise set
+ # already. Restrict the maximum key size to some sensible value if it
+ # is not set already: we do not want to allow the user to enter an
+ # arbitrarily large integer.
+ $args{-min} = 0 unless exists $args{-min};
+ $args{-max} = 1024 unless exists $args{-max};
+ $validate = sub {
+ $_[0] =~ $int_pat and $_[0] >= $args{-min} and $_[0] <= $args{-max}
+ };
+ }
+
+ my $key_len = $self->opts()->{'key-len'};
+ my $key = $self->opts()->{key};
+ if (defined $key_len) {
+ if ($validate->($key_len)) {
+ $self->show_found_var('Using specified key length', $key_len);
+ }
+ else {
+ $self->exit_with_error(115, "Invalid key length '%d'", $key_len);
+ }
+ }
+ elsif (defined $key and $key ne RAND_OPTION_STR) {
+ $key_len = length($key) / 2;
+ if ($validate->($key_len)) {
+ $self->show_found_var('Using inferred key length', $key_len);
+ }
+ else {
+ $self->exit_with_error(116, "Invalid length key (%d)", $key_len);
+ }
+ }
+ elsif (exists $args{-fixed}) {
+ $key_len = $args{-fixed};
+ $self->show_found_var('Using fixed key length', $key_len);
+ }
+ else {
+ my $message = "This is a variable key length algorithm.\n";
+
+ if (exists $args{-valid}) {
+ my @key_lens = @{$args{-valid}};
+ my $max_key_len = pop @key_lens;
+ $message .= sprintf 'Valid key lengths are: %s or %d bytes.',
+ join(', ', @key_lens), $max_key_len;
+ }
+ else {
+ $message .= sprintf 'Valid key lengths are from %d byte%s up to ' .
+ '%d byte%s.',
+ $args{-min}, $args{-min} == 1 ? '' : 's',
+ $args{-max}, $args{-max} == 1 ? '' : 's';
+ }
+
+ my $question = 'What key length (in bytes) do you want to use?';
+
+ $key_len = $self->prompt_validate(
+ -message => $message,
+ -question => $question,
+ -default => $args{-default},
+ -validate => $validate
+ );
+ }
+ print "\n";
+
+ $self->key_len($key_len);
}
-#===============================================================================
-# MAIN PROGRAM
-#===============================================================================
+sub query_rc2_key_bits {
+ my $self = shift;
-MAIN: {
- name ('Filter-Crypto');
- license ('perl');
- all_from ('lib/Filter/Crypto.pm');
- configure_requires ('Carp');
- configure_requires ('Config');
- configure_requires ('Cwd');
- configure_requires ('ExtUtils::MakeMaker');
- configure_requires ('File::Basename');
- configure_requires ('File::Copy');
- configure_requires ('File::Find');
- configure_requires ('File::Path');
- configure_requires ('File::Spec');
- configure_requires ('File::Spec::Functions');
- configure_requires ('FindBin');
- configure_requires ('Getopt::Long');
- configure_requires ('Pod::Usage' => '1.15');
- configure_requires ('Text::Wrap');
- configure_requires ('constant');
- configure_requires ('parent');
- configure_requires ('strict');
- configure_requires ('vars');
- configure_requires ('warnings');
- test_requires ('Test::More');
- test_requires ('blib');
- requires ('Exporter');
- requires ('Fcntl');
- requires ('Scalar::Util');
- requires ('Text::ParseWords');
- requires ('XSLoader');
- recommends ('File::Temp');
- recommends ('PAR::Filter');
- feature ('crypt_file -e tempfile support' => [
- -default => 0,
- 'File::Temp'
- ]);
- feature ('PAR::Filter support' => [
- -default => 0,
- 'PAR::Filter',
- 'File::Temp'
- ]);
- feature ('Fuller PAR::Filter::Crypto testing' => [
- -default => 0,
- 'Archive::Zip'
- ]);
- feature ('POD testing' => [
- -default => 0,
- 'Test::Pod' => '1.00'
- ]);
- clean_files ('CipherConfig.h');
-
- my $obj = get_filter_crypto_private_obj();
+ # The "effective key bits" parameter can be from 1 to 1024 bits: see RFC
+ # 2268.
+ my %args = (-min => 1, -max => 1024, -default => 128);
- my @opt_specs = (
- 'prefix-dir|d=s',
- 'cipher-config|c=s',
- 'cipher-name|n=s',
- 'cipher-mode|m=s',
- 'pswd|p=s',
- 'key|k=s',
- 'rng|r=s',
- 'key-len|l=i',
- 'rc2-key-bits=i',
- 'rc5-rounds=i',
- 'install-script|i=s',
- 'build|b=s',
- 'unsafe-mode|u',
- 'debug-mode'
- );
+ my $int_pat = qr/^(?:0|[1-9](?:\d+)?)$/o;
+ my $validate = sub {
+ $_[0] =~ $int_pat and $_[0] >= $args{-min} and $_[0] <= $args{-max}
+ };
+
+ my $rc2_key_bits = $self->opts()->{'rc2-key-bits'};
+ if (defined $rc2_key_bits) {
+ if ($validate->($rc2_key_bits)) {
+ $self->show_found_var(
+ 'Using specified RC2 key bits', $rc2_key_bits
+ );
+ }
+ else {
+ $self->exit_with_error(117,
+ "Invalid RC2 key bits '%d'", $rc2_key_bits
+ );
+ }
+ }
+ else {
+ my $message = "This algorithm also has an 'effective key bits' (EKB) " .
+ "parameter.\n";
+
+ $message .= sprintf 'Valid EKB values are from %d bit%s up to %d ' .
+ 'bit%s.',
+ $args{-min}, $args{-min} == 1 ? '' : 's',
+ $args{-max}, $args{-max} == 1 ? '' : 's';
+
+ my $question = 'What EKB value (in bits) do you want to use?';
+
+ $rc2_key_bits = $self->prompt_validate(
+ -message => $message,
+ -question => $question,
+ -default => $args{-default},
+ -validate => $validate
+ );
+ }
+ print "\n";
+
+ $self->rc2_key_bits($rc2_key_bits);
+}
- $obj->process_opts(\@opt_specs, 1);
- $obj->check_compiler(1);
+sub query_rc5_rounds {
+ my $self = shift;
- $obj->locate_openssl();
- $obj->configure_cipher();
+ # The "number of rounds" parameter can be from 0 to 255: see RFC 2040.
+ # However, it can currently only be set to 8, 12 or 16 by the RC5 code in
+ # OpenSSL: see EVP_EncryptInit.pod in recent OpenSSL distributions.
+ my %args = (-valid => [8, 12, 16], -default => 12);
- my $build = $obj->query_build();
+ my %valid = map { $_ => 1 } @{$args{-valid}};
+ my $validate = sub { exists $valid{$_[0]} };
- if ("@$build" =~ /Decrypt/o) {
- $obj->check_perl();
+ my $rc5_rounds = $self->opts()->{'rc5-rounds'};
+ if (defined $rc5_rounds) {
+ if ($validate->($rc5_rounds)) {
+ $self->show_found_var('Using specified RC5 rounds', $rc5_rounds);
+ }
+ else {
+ $self->exit_with_error(118,
+ "Invalid RC5 rounds '%d'", $rc5_rounds
+ );
+ }
}
+ else {
+ my $message = "This algorithm also has a 'number of rounds' " .
+ "parameter.\n";
+
+ my @rc5_rounds = @{$args{-valid}};
+ my $max_rc5_rounds = pop @rc5_rounds;
+ $message .= sprintf 'Valid numbers of rounds are: %s or %d.',
+ join(', ', @rc5_rounds), $max_rc5_rounds;
- my @script_specs;
- if ("@$build" =~ /CryptFile/o) {
- @script_specs = qw(
- crypt_file=y
+ my $question = 'What number of rounds do you want to use?';
+
+ $rc5_rounds = $self->prompt_validate(
+ -message => $message,
+ -question => $question,
+ -default => $args{-default},
+ -validate => $validate
);
}
+ print "\n";
+
+ $self->rc5_rounds($rc5_rounds);
+}
+
+sub query_pswd_or_key {
+ my $self = shift;
+
+ my $key_len = $self->key_len();
+
+ if ($key_len == 0) {
+ $self->key('');
+ return;
+ }
+
+ my $validate_pswd = sub {
+ $_[0] ne ''
+ };
+
+ my $validate_key = sub {
+ $_[0] =~ /^[0-9a-f]*$/io and length $_[0] == 2 * $key_len
+ };
+
+ my $pswd = $self->opts()->{pswd};
+ my $key = $self->opts()->{key};
+ if (defined $pswd) {
+ if (lc $pswd eq lc RAND_OPTION_STR) {
+ $pswd = $self->generate_rand_pswd();
+ print "\n";
+
+ $self->show_found_var('Using randomly generated password', $pswd);
+ $self->pswd($pswd);
+ }
+ elsif ($validate_pswd->($pswd)) {
+ $self->show_found_var('Using specified password', $pswd);
+ $self->pswd(unpack 'H*', $pswd);
+ }
+ else {
+ $self->exit_with_error(119, "Invalid password '%s'", $pswd);
+ }
+ }
+ elsif (defined $key) {
+ if (lc $key eq lc RAND_OPTION_STR) {
+ $key = $self->generate_rand_key();
+ print "\n";
+
+ $self->show_found_var('Using randomly generated key', $key);
+ $self->key($key);
+ }
+ elsif ($validate_key->($key)) {
+ $self->show_found_var('Using specified key', $key);
+ $self->key($key);
+ }
+ else {
+ $self->exit_with_error(120, "Invalid key '%s'", $key);
+ }
+ }
else {
- @script_specs = qw(
- crypt_file=n
+ my @cipher_key_sources = (
+ [ CIPHER_KEY_GIVEN_PSWD, 'Enter a password when prompted' ],
+ [ CIPHER_KEY_RANDOM_PSWD, 'Have a password randomly generated' ],
+ [ CIPHER_KEY_GIVEN, 'Enter a key when prompted' ],
+ [ CIPHER_KEY_RANDOM, 'Have a key randomly generated' ]
);
+
+ my $message = 'You can either specify a password from which the ' .
+ 'key to be used for encryption/decryption will be ' .
+ 'derived using a PKCS#5 key derivation algorithm, or ' .
+ "you can directly specify the key to use.\n" .
+ 'You can also have a password or key randomly ' .
+ "generated for you.\n\n" .
+ 'Options for specifying or deriving the key:';
+ my $question = 'How do you want to specify or derive the key?';
+ my $default = CIPHER_KEY_RANDOM_PSWD;
+
+ my $cipher_key_source = $self->prompt_list(
+ $message, \@cipher_key_sources, $question, $default
+ );
+
+ print "\n";
+
+ if ($cipher_key_source == CIPHER_KEY_GIVEN_PSWD) {
+ $message = 'Enter your password:';
+ $question = 'Password?';
+ $default = '';
+
+ $pswd = $self->prompt_validate(
+ -message => $message,
+ -question => $question,
+ -default => $default,
+ -validate => $validate_pswd
+ );
+
+ $self->pswd(unpack 'H*', $pswd);
+ }
+ elsif ($cipher_key_source == CIPHER_KEY_RANDOM_PSWD) {
+ $pswd = $self->generate_rand_pswd();
+ $self->pswd($pswd);
+ }
+ elsif ($cipher_key_source == CIPHER_KEY_GIVEN) {
+ $message = "Enter your ${key_len}-byte key with each byte " .
+ "written as a pair of hexadecimal digits with the " .
+ "high nybble first:";
+ $question = 'Key?';
+ $default = '';
+
+ $key = $self->prompt_validate(
+ -message => $message,
+ -question => $question,
+ -default => $default,
+ -validate => $validate_key
+ );
+
+ $self->key($key);
+ }
+ elsif ($cipher_key_source == CIPHER_KEY_RANDOM) {
+ $key = $self->generate_rand_key();
+ $self->key($key);
+ }
+ else {
+ $self->exit_with_error(121,
+ "Unknown key source '%s'", $cipher_key_source
+ );
+ }
}
- $obj->query_scripts(\@script_specs);
- $obj->setup_env();
+ print "\n";
+}
- WriteMakefile(
- DIR => $build,
+sub generate_rand_key {
+ my $self = shift;
+ return $self->generate_rand_octets_hex($self->key_len());
+}
- dist => {
- DIST_CP => 'cp',
- PREOP => 'C:\\cygwin\\bin\\chmod -R a+w $(DISTVNAME) && ' .
- 'C:\\cygwin\\bin\\find $(DISTVNAME) -type f ' .
- '-exec C:\\cygwin\\bin\\dos2unix {} ; && ' .
- 'C:\\cygwin\\bin\\chmod -R a-x+rwX,go-w ' .
- '$(DISTVNAME) && ' .
- 'C:\\cygwin\\bin\\chmod a+x $(DISTVNAME)/script/*',
- TAR => 'C:\\cygwin\\bin\\tar',
- COMPRESS => 'C:\\cygwin\\bin\\gzip --best'
+sub generate_rand_pswd {
+ my $self = shift;
+ return $self->generate_rand_octets_hex(RAND_PSWD_LEN);
+}
+
+sub generate_rand_octets_hex {
+ my $self = shift;
+ my $num_octets = shift;
+
+ my $rng = $self->query_rng();
+
+ my $octets;
+ if (lc $rng eq lc RNG_PERL_RAND) {
+ $octets = '';
+ for (1 .. $num_octets) {
+ $octets .= chr int rand 256;
+ }
+ }
+ elsif (lc $rng eq lc RNG_CRYPT_RANDOM) {
+ # Delay the loading of Crypt::Random until it is actually required since
+ # it is not a standard module.
+ my $ok = eval {
+ require Crypt::Random;
+ Crypt::Random->import(qw(makerandom_octet));
+ 1;
+ };
+
+ if (not $ok) {
+ $self->exit_with_error(122,
+ "Can't load Crypt::Random module for random number generation"
+ );
+ }
+
+ # Specify "Strength => 0" to use /dev/urandom rather than /dev/random
+ # to avoid potentially blocking for a long time.
+ $octets = makerandom_octet(
+ Length => $num_octets, Strength => 0
+ );
+ }
+ elsif (lc $rng eq lc RNG_MATH_RANDOM) {
+ # Delay the loading of Math::Random until it is actually required since
+ # it is not a standard module.
+ my $ok = eval {
+ require Math::Random;
+ Math::Random->import(qw(random_uniform_integer));
+ 1;
+ };
+
+ if (not $ok) {
+ $self->exit_with_error(123,
+ "Can't load Math::Random module for random number generation"
+ );
+ }
+
+ $octets = join '',
+ map { chr } random_uniform_integer($num_octets, 0, 255);
+ }
+ elsif (lc $rng eq lc RNG_OPENSSL_RAND) {
+ my $bin_file = $self->bin_file();
+ my $out_filename = 'rand.out';
+
+ my $bin_cmd = "$bin_file rand -out $out_filename $num_octets 2>&1";
+
+ my $bin_output = `$bin_cmd`;
+ my $bin_rc = $? >> 8;
+
+ if ($bin_rc) {
+ $self->exit_with_error(124,
+ "Could not generate %d random bytes (%d):\n%s",
+ $num_octets, $bin_rc, $bin_output
+ );
+ }
+
+ sysopen my $out_fh, $out_filename, O_RDONLY | O_BINARY or
+ $self->exit_with_error(125,
+ "Could not open random bytes output file '%s' for reading: %s",
+ $out_filename, $!
+ );
+
+ my $num_octets_read = sysread $out_fh, $octets, $num_octets;
+ if (not defined $num_octets_read) {
+ $self->exit_with_error(126,
+ "Could not read random bytes from output file '%s': %s",
+ $out_filename, $!
+ );
}
+ elsif ($num_octets_read != $num_octets) {
+ $self->exit_with_error(127,
+ "Could not read random bytes from output file '%s': %d bytes " .
+ "read, %d bytes expected",
+ $out_filename, $num_octets_read, $num_octets
+ );
+ }
+
+ close $out_fh;
+ unlink $out_filename;
+ }
+ else {
+ $self->exit_with_error(128,
+ "Unknown random number generator '%s'", $rng
+ );
+ }
+
+ return unpack 'H*', $octets;
+}
+
+sub query_rng {
+ my $self = shift;
+
+ my @rngs = (
+ [ RNG_PERL_RAND, "Perl's built-in rand() function" ]
+ );
+
+ if (eval { require Crypt::Random; 1 }) {
+ push @rngs, (
+ [ RNG_CRYPT_RANDOM, 'Crypt::Random' ]
+ );
+ }
+
+ if (eval { require Math::Random; 1 }) {
+ push @rngs, (
+ [ RNG_MATH_RANDOM, 'Math::Random' ]
+ );
+ }
+
+ push @rngs, (
+ [ RNG_OPENSSL_RAND, "OpenSSL's rand command" ]
);
+
+ my $rng = $self->opts()->{rng};
+ if (defined $rng) {
+ my %lc_rngs = map { lc $_->[0] => $_->[0] } @rngs;
+ if (exists $lc_rngs{lc $rng}) {
+ $self->show_found_var('Using specified RNG', $rng);
+ $rng = $lc_rngs{lc $rng};
+ }
+ else {
+ $self->exit_with_error(129,
+ "Invalid random number generator '%s'", $rng
+ );
+ }
+ }
+ else {
+ my $message = 'Random number generators:';
+ my $question = 'Which RNG do you want to use?';
+ my $default = $rngs[$#rngs][0];
+
+ $rng = $self->prompt_list(
+ $message, \@rngs, $question, $default
+ );
+ }
+
+ return $rng;
}
-#===============================================================================
-# MAKEMAKER OVERRIDES
-#===============================================================================
+sub configure_des_cipher {
+ my $self = shift;
-# Method to temporarily remove the list of sub-directories when creating the
-# (top-level) "test" target since our sub-directories have no tests of their
-# own. This saves the bother of cd'ing into them and avoids the alarming "No
-# tests defined..." message when running the top-level "test" target. (The
-# sub-directories' Makefiles still have their own "test" targets, though, so
-# anyone manually cd'ing into them and running those "test" targets will get the
-# message about there being no tests.)
-#
-# This method is based on code taken from the MY::test() method in the top-level
-# Makefile.PL script in the Tk distribution (version 804.027).
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, 'EVP_des_ecb()',
+ CIPHER_MODE_CBC, 'EVP_des_cbc()',
+ CIPHER_MODE_CFB, 'EVP_des_cfb()',
+ CIPHER_MODE_OFB, 'EVP_des_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ $self->cipher_func($cipher_funcs{$cipher_mode});
+ $self->cipher_needs_iv(1);
+
+ # The DES cipher can only use an 8 byte key (of which only 7 bytes are
+ # actually used by the algorithm): see FIPS PUB 46-3.
+ $self->query_key_len(-fixed => 8);
+}
+
+sub configure_des_ede_cipher {
+ my $self = shift;
+
+ my $ver_num = $self->ver_num();
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, ($ver_num < 90700
+ ? 'EVP_des_ede()' : 'EVP_des_ede_ecb()'),
+ CIPHER_MODE_CBC, 'EVP_des_ede_cbc()',
+ CIPHER_MODE_CFB, 'EVP_des_ede_cfb()',
+ CIPHER_MODE_OFB, 'EVP_des_ede_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ $self->cipher_func($cipher_funcs{$cipher_mode});
+ $self->cipher_needs_iv(1);
+
+ # The DES-EDE cipher is two-key triple-DES (i.e. in which an encrypt
+ # operation is encrypt with key 1, decrypt with key 2, encrypt with key 1),
+ # and therefore requires a key length equivalent to two DES keys, i.e. 16
+ # bytes (of which only 14 are used).
+ $self->query_key_len(-fixed => 16);
+}
+
+sub configure_des_ede3_cipher {
+ my $self = shift;
+
+ my $ver_num = $self->ver_num();
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, ($ver_num < 90700
+ ? 'EVP_des_ede3()' : 'EVP_des_ede3_ecb()'),
+ CIPHER_MODE_CBC, 'EVP_des_ede3_cbc()',
+ CIPHER_MODE_CFB, 'EVP_des_ede3_cfb()',
+ CIPHER_MODE_OFB, 'EVP_des_ede3_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ $self->cipher_func($cipher_funcs{$cipher_mode});
+ $self->cipher_needs_iv(1);
+
+ # The DES-EDE3 cipher is three-key triple-DES (i.e. in which an encrypt
+ # operation is encrypt with key 1, decrypt with key 2, encrypt with key 3),
+ # and therefore requires a key length equivalent to two DES keys, i.e. 24
+ # bytes (of which only 21 are used).
+ $self->query_key_len(-fixed => 24);
+}
+
+sub configure_rc4_cipher {
+ my $self = shift;
+
+ $self->cipher_func('EVP_rc4()');
+ $self->cipher_needs_iv(0);
+
+ # The RC4 cipher can use any key length: see rc4.doc in old SSLeay
+ # distributions.
+ $self->query_key_len(-min => 1, -default => 16);
+}
+
+sub configure_idea_cipher {
+ my $self = shift;
+
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, 'EVP_idea_ecb()',
+ CIPHER_MODE_CBC, 'EVP_idea_cbc()',
+ CIPHER_MODE_CFB, 'EVP_idea_cfb()',
+ CIPHER_MODE_OFB, 'EVP_idea_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ $self->cipher_func($cipher_funcs{$cipher_mode});
+ $self->cipher_needs_iv(1);
+
+ # The IDEA cipher can only use a 16 byte key: see idea.doc in old SSLeay
+ # distributions.
+ $self->query_key_len(-fixed => 16);
+}
+
+sub configure_rc2_cipher {
+ my $self = shift;
+
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, 'EVP_rc2_ecb()',
+ CIPHER_MODE_CBC, 'EVP_rc2_cbc()',
+ CIPHER_MODE_CFB, 'EVP_rc2_cfb()',
+ CIPHER_MODE_OFB, 'EVP_rc2_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ $self->cipher_func($cipher_funcs{$cipher_mode});
+ $self->cipher_needs_iv(1);
+
+ # The RC2 cipher can use any key length from 1 to 128 bytes: see RFC 2268.
+ $self->query_key_len(-min => 1, -max => 128, -default => 16);
+
+ # The RC2 cipher also has a parameter called "effective key bits".
+ $self->query_rc2_key_bits();
+}
+
+sub configure_desx_cipher {
+ my $self = shift;
+
+ $self->cipher_func('EVP_desx_cbc()');
+ $self->cipher_needs_iv(1);
+
+ # The DESX cipher can only use a 24 byte key: see des.pod in recent OpenSSL
+ # distributions.
+ $self->query_key_len(-fixed => 24);
+}
+
+sub configure_blowfish_cipher {
+ my $self = shift;
+
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, 'EVP_bf_ecb()',
+ CIPHER_MODE_CBC, 'EVP_bf_cbc()',
+ CIPHER_MODE_CFB, 'EVP_bf_cfb()',
+ CIPHER_MODE_OFB, 'EVP_bf_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ $self->cipher_func($cipher_funcs{$cipher_mode});
+ $self->cipher_needs_iv(1);
+
+ # The Blowfish cipher can use any key length up to 72 bytes: see
+ # blowfish.doc in old SSLeay distributions.
+ $self->query_key_len(-min => 1, -max => 72, -default => 16);
+}
+
+sub configure_null_cipher {
+ my $self = shift;
+
+ $self->cipher_func('EVP_enc_null()');
+ $self->cipher_needs_iv(0);
+
+ # The null cipher does not require a key: it does nothing.
+ $self->query_key_len(-fixed => 0);
+}
+
+sub configure_rc5_cipher {
+ my $self = shift;
+
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, 'EVP_rc5_32_12_16_ecb()',
+ CIPHER_MODE_CBC, 'EVP_rc5_32_12_16_cbc()',
+ CIPHER_MODE_CFB, 'EVP_rc5_32_12_16_cfb()',
+ CIPHER_MODE_OFB, 'EVP_rc5_32_12_16_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ $self->cipher_func($cipher_funcs{$cipher_mode});
+ $self->cipher_needs_iv(1);
+
+ # The RC5 cipher can use any key length from 0 to 255 bytes: see RFC 2040.
+ $self->query_key_len(-min => 0, -max => 255, -default => 16);
+
+ # The RC5 cipher also has a parameter called "number of rounds".
+ $self->query_rc5_rounds();
+}
+
+sub configure_cast5_cipher {
+ my $self = shift;
+
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, 'EVP_cast5_ecb()',
+ CIPHER_MODE_CBC, 'EVP_cast5_cbc()',
+ CIPHER_MODE_CFB, 'EVP_cast5_cfb()',
+ CIPHER_MODE_OFB, 'EVP_cast5_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ $self->cipher_func($cipher_funcs{$cipher_mode});
+ $self->cipher_needs_iv(1);
+
+ # The CAST5 cipher can use any key length from 5 to 16 bytes: see RFC 2144.
+ $self->query_key_len(-min => 5, -max => 16, -default => 16);
+}
+
+sub configure_aes_cipher {
+ my $self = shift;
+
+ my %cipher_funcs = (
+ CIPHER_MODE_ECB, 'EVP_aes_ecb()',
+ CIPHER_MODE_CBC, 'EVP_aes_cbc()',
+ CIPHER_MODE_CFB, 'EVP_aes_cfb()',
+ CIPHER_MODE_OFB, 'EVP_aes_ofb()'
+ );
+ my $cipher_mode = $self->query_cipher_mode();
+ my $cipher_func = $cipher_funcs{$cipher_mode};
+
+ # The AES cipher can only use a 16, 24 or 32 byte key: see FIPS PUB 197. Do
+ # not offer the choice of 24 or 32 byte keys for 0.9.7 because they do not
+ # seem to work. I do not know why, and the problem does not seem to occur
+ # with debug OpenSSL builds, which does not make it very easy to find out
+ # why.
+ my $ver_num = $self->ver_num();
+ if ($ver_num == 90700) {
+ $self->query_key_len(-fixed => 16);
+ }
+ else {
+ $self->query_key_len(-valid => [16, 24, 32], -default => 32);
+ }
+
+ my $key_len_bits = $self->key_len() * 8;
+ $cipher_func =~ s/_aes_/_aes_${key_len_bits}_/;
+ $self->cipher_func($cipher_func);
+ $self->cipher_needs_iv(1);
+}
+
+sub write_cipher_config {
+ my $self = shift;
+
+ open my $cfg_fh, '>', CIPHER_CONFIG_FILENAME or
+ $self->exit_with_error(130,
+ "Could not open configuration file '%s' for writing: %s",
+ CIPHER_CONFIG_FILENAME, $!
+ );
+
+ my $prefix_dir = $self->prefix_dir();
+ my $ver_str = $self->ver_str();
+
+ print $cfg_fh <<"EOT";
+/*============================================================================
+ *
+ * @{[CIPHER_CONFIG_FILENAME]}
+ *
+ * DESCRIPTION
+ * Cipher configuration file for Filter::Crypto modules.
+ *
+ * DO NOT EDIT THIS FILE!
+ *
+ * This file is written by Makefile.PL from its command-line option values
+ * and/or default values. Any changes made here will be lost the next time
+ * Makefile.PL is run.
+ *
+ * Created at @{[scalar localtime]} by Perl version $], installed as
+ * $^X
+ *
+ * Configured against OpenSSL version $ver_str, installed under
+ * $prefix_dir
+ *
+ *============================================================================*/
+
+EOT
+
+ my $cipher_func = $self->cipher_func();
+ print $cfg_fh "#define FILTER_CRYPTO_CIPHER_FUNC $cipher_func\n";
+
+ if ($self->cipher_needs_iv()) {
+ print $cfg_fh "#define FILTER_CRYPTO_NEED_IV 1\n";
+ }
+ else {
+ print $cfg_fh "#define FILTER_CRYPTO_NEED_IV 0\n";
+ }
+
+ my $key_len = $self->key_len();
+ print $cfg_fh "#define FILTER_CRYPTO_KEY_LEN $key_len\n";
+
+ my $rc2_key_bits = $self->rc2_key_bits();
+ my $rc5_rounds = $self->rc5_rounds();
+ if (defined $rc2_key_bits) {
+ print $cfg_fh "#define FILTER_CRYPTO_RC2_KEY_BITS $rc2_key_bits\n";
+ }
+ elsif (defined $rc5_rounds) {
+ print $cfg_fh "#define FILTER_CRYPTO_RC5_ROUNDS $rc5_rounds\n";
+ }
+
+ my($def, $var);
+ if ($key_len == 0) {
+ $def = '#define FILTER_CRYPTO_USING_PBE 0';
+ $var = 'static const unsigned char *filter_crypto_key = NULL;';
+ }
+ else {
+ my $pswd = $self->pswd();
+ if (defined $pswd) {
+ $def = '#define FILTER_CRYPTO_USING_PBE 1';
+ $pswd = $self->format_chars($pswd);
+ $var = "static const unsigned char filter_crypto_pswd[] = {\n" .
+ "$pswd\n" .
+ "};";
+ }
+ else {
+ $def = '#define FILTER_CRYPTO_USING_PBE 0';
+ my $key = $self->key();
+ $key = $self->format_chars($key);
+ $var = "static const unsigned char filter_crypto_key[] = {\n" .
+ "$key\n" .
+ "};";
+ }
+ }
+ print $cfg_fh "$def\n\n";
+ print $cfg_fh "$var\n";
+
+ print $cfg_fh <<'EOT';
+
+/*============================================================================*/
+EOT
+
+ close $cfg_fh;
+
+ print wrap('', '',
+ "Your cipher configuration has been written to the file '" .
+ CIPHER_CONFIG_FILENAME . "'. You may want to keep this file in a " .
+ "safe place if you ever need to rebuild these modules using the same " .
+ "configuration, especially if your key was randomly generated."
+ ), "\n\n";
+}
+
+sub format_chars {
+ my $self = shift;
+ my $chars = shift;
+
+ $chars =~ s/(..)/0x$1, /g;
+ $chars =~ s/^/ /o;
+ $chars =~ s/, $//o;
+ $chars =~ s/((?:0x.., ){8})/$1\n /g;
+ $chars =~ s/ \n/\n/go;
+ $chars =~ s/\n $//o;
+
+ return $chars;
+}
+
+sub copy_cipher_config {
+ my $self = shift;
+ my $cipher_config_file = shift;
+
+ if ($cipher_config_file ne CIPHER_CONFIG_FILENAME) {
+ copy($cipher_config_file, CIPHER_CONFIG_FILENAME) or
+ $self->exit_with_error(131,
+ "Could not copy configuration file '%s' to '%s': %s",
+ $cipher_config_file, CIPHER_CONFIG_FILENAME, $!
+ );
+ }
+
+ print "\n";
+}
-sub MY::test {
- my($self, %args) = @_;
- my $dir = delete $self->{DIR};
- my $str = $self->MM::test(%args);
- $self->{DIR} = $dir;
- return $str;
}
__END__
@@ -215,13 +2292,10 @@ variable as usual.
=head1 OPTIONS
-Any standard Module::AutoInstall command-line options may be specified. These
-can also be given in the PERL_AUTOINSTALL environment variable as usual.
-
-In addition, the build process for this distribution requires the answers to
-various questions regarding (amongst other things) the location of OpenSSL or
-SSLeay, which cipher algorithm to use, what password or key to use and whether
-to install a script.
+The build process for this distribution requires the answers to various
+questions regarding (amongst other things) the location of OpenSSL or SSLeay,
+which cipher algorithm to use, what password or key to use and whether to
+install a script.
The command-line options detailed below can be used to provide the answers to
these questions.
@@ -229,11 +2303,10 @@ these questions.
If a particular question is not answered via the relevant command-line option
then B<Makefile.PL> will normally prompt the user for the answer. However, if
it detects that it is not being run interactively and there is nothing on
-C<STDIN>, or if your ExtUtils::MakeMaker is version 5.48_01 or later and either
-the PERL_MM_USE_DEFAULT environment variable is set to a true value or the
-B<--defaults> option is specified, then the default value indicated below in the
-description of the option concerned will be used instead and no questions will
-be asked.
+C<STDIN>, or if either the PERL_MM_USE_DEFAULT environment variable is set to a
+true value or the B<--defaults> option is specified, then the default value
+indicated below in the description of the option concerned will be used instead
+and no questions will be asked.
=over 4
@@ -243,9 +2316,6 @@ Specify that the default value indicated below of each option that is not
specified by the relevant command-line option will be used instead of prompting
the user for a response.
-You must be using ExtUtils::MakeMaker version 5.48_01 or later for this option
-to have any effect.
-
=item B<-d E<lt>dirE<gt>>, B<--prefix-dir=E<lt>dirE<gt>>
Specify the OpenSSL or SSLeay prefix directory. This is used to determine the
@@ -316,13 +2386,10 @@ value "rand" means that a 32-byte password will be randomly generated using the
random number generator specified by the B<--rng> option.
The key will be derived using the PBKDF2 algorithm defined in PKCS#5 v2.0 (which
-is also available as RFC2898) if you have OpenSSL 0.9.4 or later. This is not
-available in earlier versions of OpenSSL or SSLeay so in those cases a different
-algorithm, largely compatible with PKCS#5 v1.5, is used instead. In either case
-an 8-byte random salt and 2048 iterations are used. A random initialization
-vector (IV) is also generated if required. When encrypting, both the salt and
-IV are prepended to the ciphertext so that they may be recovered for use when
-decrypting.
+is also available as RFC2898). An 8-byte random salt and 2048 iterations are
+used. A random initialization vector (IV) is also generated if required. When
+encrypting, both the salt and IV are prepended to the ciphertext so that they
+may be recovered for use when decrypting.
Alternatively, the key may be specified directly (or randomly generated) using
the B<--key> option below. If both options are given then B<--pswd> is used and
@@ -346,10 +2413,8 @@ special value "rand" means that a key of the appropriate length will be randomly
generated using the random number generator specified by the B<--rng> option.
If a key length is also specified using the B<--key-len> option below, or if you
-have chosen a fixed key length cipher or are using something earlier than
-OpenSSL 0.9.6 (with which the variable key length ciphers can only be used with
-their default key lengths), then the length of any key specified here must match
-the relevant key length.
+have chosen a fixed key length cipher, then the length of any key specified here
+must match the relevant key length.
An N-byte key must be specified as a string of 2*N hexadecimal digits where each
pair of such digits represents one byte of the key (with the high nybble first).
@@ -375,14 +2440,13 @@ Specify the random number generator (RNG) with which to generate the password or
key if the option to have one of them randomly generated was chosen above.
Valid RNGs are:
- Perl - Use perl's built-in rand() function
+ Perl - Use Perl's built-in rand() function
Crypt::Random - Use the Crypt::Random Perl module
Math::Random - Use the Math::Random Perl module
- OpenSSL - Use openssl's "rand" command
+ OpenSSL - Use OpenSSL's "rand" command
Note that not all of these options may be available: Crypt::Random and
-Math::Random are not standard Perl modules, and only OpenSSL 0.9.5a or later
-have a C<rand> command.
+Math::Random are not standard Perl modules.
The default RNG is whichever one nearest the end of the list above is available.
@@ -405,12 +2469,6 @@ The default key length is 16 bytes for each cipher except AES, which defaults to
32 bytes, unless a key is specified using the B<--key> option above in which
case the key length is inferred from that.
-Note that this option can only be used to change the default key length if you
-have OpenSSL version 0.9.6 or later because the facility for setting key lengths
-was only added to the EVP library API used by this software in version 0.9.6.
-The default key length will always be used with earlier versions of OpenSSL or
-SSLeay.
-
The key length of the fixed key length ciphers, of course, cannot be changed
using this or any other option, whatever version of OpenSSL or SSLeay you have,
but here are the key lengths used by those ciphers for reference purposes when
@@ -430,9 +2488,6 @@ above. Valid values are from 1 bit up to 1024 bits.
The default value is 128 bits.
-Note that, as for the B<--key-len> option above, this option can only be used to
-change the default value if you have OpenSSL 0.9.6 or later.
-
This option is silently ignored if the RC2 cipher was not chosen.
=item B<--rc5-rounds=E<lt>numE<gt>>
@@ -442,9 +2497,6 @@ are 8, 12 and 16.
The default value is 12 rounds.
-Note that, as for the B<--key-len> option above, this option can only be used to
-change the default value if you have OpenSSL 0.9.6 or later.
-
This option is silently ignored if the RC5 cipher was not chosen.
=item B<-i {y|n}>, B<--install-script={y|n}>
@@ -575,10 +2627,10 @@ message corresponding to the standard C library C<errno> variable is also given.
could not be generated using the OpenSSL binary executable. The exit code and
the output from the program are also given.
-=item Could not get %s version information (%d): %s
+=item Could not get OpenSSL version information (%d): %s
-(F) The OpenSSL or SSLeay version information could not be got from the binary
-executable. The exit code and the output from the program are also given.
+(F) The OpenSSL version information could not be got from the binary executable.
+The exit code and the output from the program are also given.
=item Could not open configuration file '%s' for writing: %s
@@ -666,23 +2718,22 @@ option) is not valid.
(W) The response supplied by the user to an interactive prompt was not valid.
The user will be prompted again until a valid response is supplied.
-=item No binary executable found
+=item No OpenSSL binary executable found
-(F) The main OpenSSL or SSLeay binary executable could not be located. Ensure
-that there is a full installation of OpenSSL or SSLeay in the location specified
-by the prefix directory.
+(F) The main OpenSSL binary executable could not be located. Ensure that there
+is a full installation of OpenSSL in the location specified by the prefix
+directory.
-=item No crypto library found
+=item No OpenSSL crypto library found
-(F) The OpenSSL or SSLeay "crypto" library could not be located. Ensure that
-there is a full installation of OpenSSL or SSLeay in the location specified by
-the prefix directory.
+(F) The OpenSSL "crypto" library could not be located. Ensure that there is a
+full installation of OpenSSL in the location specified by the prefix directory.
-=item No include directory found
+=item No OpenSSL/SSLeay include directory found
(F) The OpenSSL or SSLeay include directory could not be located. Ensure that
-there is a full installation of OpenSSL or SSLeay in the location specified by
-the prefix directory.
+there is a full installation of OpenSSL in the location specified by the prefix
+directory.
=item No such cipher mode '%s'
@@ -710,60 +2761,41 @@ directory is supplied.
(F) The specified prefix directory (i.e. the directory given by the
B<--prefix-dir> option) does not exist.
-=item No version number found
+=item No OpenSSL/SSLeay version number found
(F) The OpenSSL or SSLeay package's version number could not be found in the
relevant header file.
-=item No version number header file found
+=item No OpenSSL/SSLeay version number header file found
(F) The OpenSSL or SSLeay header file containing the package's version number
-could not be located. Ensure that there is a full installation of OpenSSL or
-SSLeay in the location specified by the prefix directory.
+could not be located. Ensure that there is a full installation of OpenSSL in
+the location specified by the prefix directory.
=item Options in list are not unique
(I) The method called internally to prompt the user for a choice from a list of
supposedly unique options was passed a list of options that were not all unique.
-=item OS unsupported: Compiler used to build perl ('%s') not found
-
-(F) The specified compiler that was used to build Perl could not be found and
-therefore could not be used to build this module.
-
-=item OS unsupported: Compiler used to build perl not specified in perl
-configuration
-
-(F) The compiler that was used to build Perl, which can normally be seen by
-running the command:
-
- perl -V:cc
-
-was not specified in the standard library module Config and therefore could not
-be used to build this module.
-
-=item OS unsupported: No prefix directory found for OpenSSL or SSLeay
+=item OS unsupported: No OpenSSL/SSLeay directory found
(F) The OpenSSL or SSLeay prefix directory could not be located. This error is
only produced when running non-interactively. (In interactive mode the user
will be prompted for the prefix directory if it was not given by the
B<--prefix-dir> option.)
+=item OS unsupported: OpenSSL version 0.9.6k or 0.9.7c or higher required. This is only %s version %s
+
+(F) You do not have a sufficiently recent version of OpenSSL (namely, 0.9.6N
+where N is k or higher, or 0.9.7N where N is c or higher, or 0.9.8 or higher).
+
=item OS unsupported: The "Decrypt" component requires a "release" mode build of
-Perl (i.e. one built without DEBUGGING)
+perl (i.e. one built without DEBUGGING)
-(F) The Perl being used was built in "debug" mode, which is not supported by the
+(F) The perl being used was built in "debug" mode, which is not supported by the
"Decrypt" component unless specifically enabled with the B<--debug-mode>
command-line option.
-=item OS unsupported: Wrong compiler version ('%s'). Perl was built with version
-'%s'. Please see INSTALL file for details
-
-(F) A different version of the compiler that was used to build Perl is being
-used to build this module. This is not allowed since it is known to cause
-breakages with some combinations of compilers. Please use the same compiler to
-build this module as was used to build Perl itself.
-
=item Unknown key source '%s'
(I) The method called internally to prompt the user for a choice of how to
@@ -774,25 +2806,16 @@ specify the cipher key returned an unknown value.
(I) The method called internally to prompt the user for a choice random number
generator returned an unknown value.
-=item Unrecognized version number found (%s)
+=item Unrecognized OpenSSL/SSLeay version number found (%s)
(F) The OpenSSL or SSLeay package's version number, read from the relevant
header file, is not in a format that is recognized.
-=item Warning: %s ignored: requires ExtUtils::MakeMaker version 5.48_01 or later
-
-(W) You either specified the B<--defaults> command-line option or you have the
-PERL_MM_USE_DEFAULT environment variable set to a true value, but you do not
-have ExtUtils::MakeMaker version 5.48_01 or later, without which these options
-have no effect. The user will therefore be prompted for responses as usual
-instead.
+=item Warning: Ignoring Cygwin OpenSSL binary '%s' on Win32
-=item Warning: Ignoring Cygwin OpenSSL/SSLeay binary '%s' on Win32
-
-(W) The main OpenSSL or SSLeay binary executable found in the PATH when trying
-to locate the OpenSSL or SSLeay to use turned out to be a Cygwin binary, which
-is of no use with the Win32 perl that is being used and will therefore be
-ignored.
+(W) The main OpenSSL binary executable found in the PATH when trying to locate
+the OpenSSL to use turned out to be a Cygwin binary, which is of no use with the
+Win32 perl that is being used and will therefore be ignored.
=back
@@ -858,16 +2881,10 @@ B<-d> option as shown in the previous examples too.
=head1 ENVIRONMENT
-Any standard Module::AutoInstall and ExtUtils::MakeMaker environment variables
-may be used, namely:
+Any standard ExtUtils::MakeMaker environment variables may be used, namely:
=over 4
-=item PERL_AUTOINSTALL
-
-Specify Module::AutoInstall command-line options to be postpended to the list of
-command-line options before its option processing takes place.
-
=item PERL_MM_OPT
Specify ExtUtils::MakeMaker command-line arguments to be prepended to the list
@@ -887,35 +2904,30 @@ If set to a true value then the default value (indicated under L<"OPTIONS">
above) of each option that is not specified on the command-line will be used
instead of prompting the user for a response.
-You must be using ExtUtils::MakeMaker version 5.48_01 or later for this option
-to have any effect.
-
=back
=head1 SEE ALSO
The F<INSTALL> file;
-L<ExtUtils::MakeMaker>;
-
-L<Module::AutoInstall>.
+L<ExtUtils::MakeMaker>.
=head1 ACKNOWLEDGEMENTS
The C<MY::test()> override method is based on code taken from that in the
-top-level B<Makefile.PL> script in the Tk distribution (version 804.027),
+top-level B<Makefile.PL> script in the Tk distribution (version 804.032),
written by Nick Ing-Simmons.
-The C<check_compiler()> method in the Module::Install::PRIVATE module used by
-this script is based on code taken from the C<get_avail_w32compilers()> function
-in the B<configsmoke.pl> script in the Test-Smoke distribution (version 1.19),
-written by Abe Timmerman.
+The C<can_run()> method in the Filter::Crypto::_ConfigureBuild class is based on
+code taken from the C<can_run()> method in the standard library module IPC::Cmd
+(version 0.92), written by Jos Boumans and currently maintained by Chris
+Williams.
-The C<_use_default_response()> and C<_isa_tty()> methods in the
-Module::Install::PRIVATE module used by this script are based on code taken from
-the C<prompt()> function in the standard library module ExtUtils::MakeMaker
-(version 6.17), written by Andy Dougherty, Andreas Koenig and Tim Bunce, and
-currently maintained by Michael G Schwern.
+The C<use_default_response()> and C<isa_tty()> methods in the
+Filter::Crypto::_ConfigureBuild class are based on code taken from the
+C<prompt()> function in the standard library module ExtUtils::MakeMaker (version
+6.92), written by Andy Dougherty, Andreas Koenig and Tim Bunce, and currently
+maintained by Michael G Schwern.
=head1 AUTHOR
@@ -923,7 +2935,7 @@ Steve Hay E<lt>shay@cpan.orgE<gt>
=head1 COPYRIGHT
-Copyright (C) 2004-2009, 2012 Steve Hay. All rights reserved.
+Copyright (C) 2004-2009, 2012, 2014 Steve Hay. All rights reserved.
=head1 LICENCE
@@ -933,11 +2945,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 1.10
+Version 1.13
=head1 DATE
-20 Mar 2012
+30 May 2014
=head1 HISTORY
@@ -1,6 +1,6 @@
________________________________________________________________________________
- Filter::Crypto, Version 2.03
+ Filter::Crypto, Version 2.06
________________________________________________________________________________
NAME
@@ -93,7 +93,7 @@ INSTALLATION
COPYRIGHT
- Copyright (C) 2004-2010, 2012-2013 Steve Hay. All rights reserved.
+ Copyright (C) 2004-2010, 2012-2014 Steve Hay. All rights reserved.
LICENCE
@@ -1,930 +0,0 @@
-#line 1
-package Module::AutoInstall;
-
-use strict;
-use Cwd ();
-use File::Spec ();
-use ExtUtils::MakeMaker ();
-
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '1.06';
-}
-
-# special map on pre-defined feature sets
-my %FeatureMap = (
- '' => 'Core Features', # XXX: deprecated
- '-core' => 'Core Features',
-);
-
-# various lexical flags
-my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
-my (
- $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
- $UpgradeDeps
-);
-my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
- $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
- $PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
-
-# See if it's a testing or non-interactive session
-_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
-_init();
-
-sub _accept_default {
- $AcceptDefault = shift;
-}
-
-sub _installdeps_target {
- $InstallDepsTarget = shift;
-}
-
-sub missing_modules {
- return @Missing;
-}
-
-sub do_install {
- __PACKAGE__->install(
- [
- $Config
- ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- : ()
- ],
- @Missing,
- );
-}
-
-# initialize various flags, and/or perform install
-sub _init {
- foreach my $arg (
- @ARGV,
- split(
- /[\s\t]+/,
- $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
- )
- )
- {
- if ( $arg =~ /^--config=(.*)$/ ) {
- $Config = [ split( ',', $1 ) ];
- }
- elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
- __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
- exit 0;
- }
- elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
- $UpgradeDeps = 1;
- __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
- exit 0;
- }
- elsif ( $arg =~ /^--default(?:deps)?$/ ) {
- $AcceptDefault = 1;
- }
- elsif ( $arg =~ /^--check(?:deps)?$/ ) {
- $CheckOnly = 1;
- }
- elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
- $SkipInstall = 1;
- }
- elsif ( $arg =~ /^--test(?:only)?$/ ) {
- $TestOnly = 1;
- }
- elsif ( $arg =~ /^--all(?:deps)?$/ ) {
- $AllDeps = 1;
- }
- }
-}
-
-# overrides MakeMaker's prompt() to automatically accept the default choice
-sub _prompt {
- goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
-
- my ( $prompt, $default ) = @_;
- my $y = ( $default =~ /^[Yy]/ );
-
- print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
- print "$default\n";
- return $default;
-}
-
-# the workhorse
-sub import {
- my $class = shift;
- my @args = @_ or return;
- my $core_all;
-
- print "*** $class version " . $class->VERSION . "\n";
- print "*** Checking for Perl dependencies...\n";
-
- my $cwd = Cwd::cwd();
-
- $Config = [];
-
- my $maxlen = length(
- (
- sort { length($b) <=> length($a) }
- grep { /^[^\-]/ }
- map {
- ref($_)
- ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
- : ''
- }
- map { +{@args}->{$_} }
- grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
- )[0]
- );
-
- # We want to know if we're under CPAN early to avoid prompting, but
- # if we aren't going to try and install anything anyway then skip the
- # check entirely since we don't want to have to load (and configure)
- # an old CPAN just for a cosmetic message
-
- $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
-
- while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
- my ( @required, @tests, @skiptests );
- my $default = 1;
- my $conflict = 0;
-
- if ( $feature =~ m/^-(\w+)$/ ) {
- my $option = lc($1);
-
- # check for a newer version of myself
- _update_to( $modules, @_ ) and return if $option eq 'version';
-
- # sets CPAN configuration options
- $Config = $modules if $option eq 'config';
-
- # promote every features to core status
- $core_all = ( $modules =~ /^all$/i ) and next
- if $option eq 'core';
-
- next unless $option eq 'core';
- }
-
- print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
-
- $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
-
- unshift @$modules, -default => &{ shift(@$modules) }
- if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
-
- while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
- if ( $mod =~ m/^-(\w+)$/ ) {
- my $option = lc($1);
-
- $default = $arg if ( $option eq 'default' );
- $conflict = $arg if ( $option eq 'conflict' );
- @tests = @{$arg} if ( $option eq 'tests' );
- @skiptests = @{$arg} if ( $option eq 'skiptests' );
-
- next;
- }
-
- printf( "- %-${maxlen}s ...", $mod );
-
- if ( $arg and $arg =~ /^\D/ ) {
- unshift @$modules, $arg;
- $arg = 0;
- }
-
- # XXX: check for conflicts and uninstalls(!) them.
- my $cur = _version_of($mod);
- if (_version_cmp ($cur, $arg) >= 0)
- {
- print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
- push @Existing, $mod => $arg;
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
- else {
- if (not defined $cur) # indeed missing
- {
- print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
- }
- else
- {
- # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
- print "too old. ($cur < $arg)\n";
- }
-
- push @required, $mod => $arg;
- }
- }
-
- next unless @required;
-
- my $mandatory = ( $feature eq '-core' or $core_all );
-
- if (
- !$SkipInstall
- and (
- $CheckOnly
- or ($mandatory and $UnderCPAN)
- or $AllDeps
- or $InstallDepsTarget
- or _prompt(
- qq{==> Auto-install the }
- . ( @required / 2 )
- . ( $mandatory ? ' mandatory' : ' optional' )
- . qq{ module(s) from CPAN?},
- $default ? 'y' : 'n',
- ) =~ /^[Yy]/
- )
- )
- {
- push( @Missing, @required );
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
-
- elsif ( !$SkipInstall
- and $default
- and $mandatory
- and
- _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
- =~ /^[Nn]/ )
- {
- push( @Missing, @required );
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
-
- else {
- $DisabledTests{$_} = 1 for map { glob($_) } @tests;
- }
- }
-
- if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
- require Config;
- my $make = $Config::Config{make};
- if ($InstallDepsTarget) {
- print
-"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
- }
- else {
- print
-"*** Dependencies will be installed the next time you type '$make'.\n";
- }
-
- # make an educated guess of whether we'll need root permission.
- print " (You may need to do that as the 'root' user.)\n"
- if eval '$>';
- }
- print "*** $class configuration finished.\n";
-
- chdir $cwd;
-
- # import to main::
- no strict 'refs';
- *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
-
- return (@Existing, @Missing);
-}
-
-sub _running_under {
- my $thing = shift;
- print <<"END_MESSAGE";
-*** Since we're running under ${thing}, I'll just let it take care
- of the dependency's installation later.
-END_MESSAGE
- return 1;
-}
-
-# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
-# if we are, then we simply let it taking care of our dependencies
-sub _check_lock {
- return unless @Missing or @_;
-
- if ($ENV{PERL5_CPANM_IS_RUNNING}) {
- return _running_under('cpanminus');
- }
-
- my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
-
- if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
- return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
- }
-
- require CPAN;
-
- if ($CPAN::VERSION > '1.89') {
- if ($cpan_env) {
- return _running_under('CPAN');
- }
- return; # CPAN.pm new enough, don't need to check further
- }
-
- # last ditch attempt, this -will- configure CPAN, very sorry
-
- _load_cpan(1); # force initialize even though it's already loaded
-
- # Find the CPAN lock-file
- my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
- return unless -f $lock;
-
- # Check the lock
- local *LOCK;
- return unless open(LOCK, $lock);
-
- if (
- ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
- and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
- ) {
- print <<'END_MESSAGE';
-
-*** Since we're running under CPAN, I'll just let it take care
- of the dependency's installation later.
-END_MESSAGE
- return 1;
- }
-
- close LOCK;
- return;
-}
-
-sub install {
- my $class = shift;
-
- my $i; # used below to strip leading '-' from config keys
- my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
-
- my ( @modules, @installed );
- while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
-
- # grep out those already installed
- if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
- push @installed, $pkg;
- }
- else {
- push @modules, $pkg, $ver;
- }
- }
-
- if ($UpgradeDeps) {
- push @modules, @installed;
- @installed = ();
- }
-
- return @installed unless @modules; # nothing to do
- return @installed if _check_lock(); # defer to the CPAN shell
-
- print "*** Installing dependencies...\n";
-
- return unless _connected_to('cpan.org');
-
- my %args = @config;
- my %failed;
- local *FAILED;
- if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
- while (<FAILED>) { chomp; $failed{$_}++ }
- close FAILED;
-
- my @newmod;
- while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
- push @newmod, ( $k => $v ) unless $failed{$k};
- }
- @modules = @newmod;
- }
-
- if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
- _install_cpanplus( \@modules, \@config );
- } else {
- _install_cpan( \@modules, \@config );
- }
-
- print "*** $class installation finished.\n";
-
- # see if we have successfully installed them
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
- push @installed, $pkg;
- }
- elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
- print FAILED "$pkg\n";
- }
- }
-
- close FAILED if $args{do_once};
-
- return @installed;
-}
-
-sub _install_cpanplus {
- my @modules = @{ +shift };
- my @config = _cpanplus_config( @{ +shift } );
- my $installed = 0;
-
- require CPANPLUS::Backend;
- my $cp = CPANPLUS::Backend->new;
- my $conf = $cp->configure_object;
-
- return unless $conf->can('conf') # 0.05x+ with "sudo" support
- or _can_write($conf->_get_build('base')); # 0.04x
-
- # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
- my $makeflags = $conf->get_conf('makeflags') || '';
- if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
- # 0.03+ uses a hashref here
- $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
-
- } else {
- # 0.02 and below uses a scalar
- $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
- if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
-
- }
- $conf->set_conf( makeflags => $makeflags );
- $conf->set_conf( prereqs => 1 );
-
-
-
- while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
- $conf->set_conf( $key, $val );
- }
-
- my $modtree = $cp->module_tree;
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- print "*** Installing $pkg...\n";
-
- MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
-
- my $success;
- my $obj = $modtree->{$pkg};
-
- if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
- my $pathname = $pkg;
- $pathname =~ s/::/\\W/;
-
- foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
- delete $INC{$inc};
- }
-
- my $rv = $cp->install( modules => [ $obj->{module} ] );
-
- if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
- print "*** $pkg successfully installed.\n";
- $success = 1;
- } else {
- print "*** $pkg installation cancelled.\n";
- $success = 0;
- }
-
- $installed += $success;
- } else {
- print << ".";
-*** Could not find a version $ver or above for $pkg; skipping.
-.
- }
-
- MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
- }
-
- return $installed;
-}
-
-sub _cpanplus_config {
- my @config = ();
- while ( @_ ) {
- my ($key, $value) = (shift(), shift());
- if ( $key eq 'prerequisites_policy' ) {
- if ( $value eq 'follow' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
- } elsif ( $value eq 'ask' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
- } elsif ( $value eq 'ignore' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
- } else {
- die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
- }
- push @config, 'prereqs', $value;
- } elsif ( $key eq 'force' ) {
- push @config, $key, $value;
- } elsif ( $key eq 'notest' ) {
- push @config, 'skiptest', $value;
- } else {
- die "*** Cannot convert option $key to CPANPLUS version.\n";
- }
- }
- return @config;
-}
-
-sub _install_cpan {
- my @modules = @{ +shift };
- my @config = @{ +shift };
- my $installed = 0;
- my %args;
-
- _load_cpan();
- require Config;
-
- if (CPAN->VERSION < 1.80) {
- # no "sudo" support, probe for writableness
- return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
- and _can_write( $Config::Config{sitelib} );
- }
-
- # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
- my $makeflags = $CPAN::Config->{make_install_arg} || '';
- $CPAN::Config->{make_install_arg} =
- join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
- if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
-
- # don't show start-up info
- $CPAN::Config->{inhibit_startup_message} = 1;
-
- # set additional options
- while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
- ( $args{$opt} = $arg, next )
- if $opt =~ /^(?:force|notest)$/; # pseudo-option
- $CPAN::Config->{$opt} = $arg;
- }
-
- if ($args{notest} && (not CPAN::Shell->can('notest'))) {
- die "Your version of CPAN is too old to support the 'notest' pragma";
- }
-
- local $CPAN::Config->{prerequisites_policy} = 'follow';
-
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
-
- print "*** Installing $pkg...\n";
-
- my $obj = CPAN::Shell->expand( Module => $pkg );
- my $success = 0;
-
- if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
- my $pathname = $pkg;
- $pathname =~ s/::/\\W/;
-
- foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
- delete $INC{$inc};
- }
-
- my $rv = do {
- if ($args{force}) {
- CPAN::Shell->force( install => $pkg )
- } elsif ($args{notest}) {
- CPAN::Shell->notest( install => $pkg )
- } else {
- CPAN::Shell->install($pkg)
- }
- };
-
- $rv ||= eval {
- $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
- ->{install}
- if $CPAN::META;
- };
-
- if ( $rv eq 'YES' ) {
- print "*** $pkg successfully installed.\n";
- $success = 1;
- }
- else {
- print "*** $pkg installation failed.\n";
- $success = 0;
- }
-
- $installed += $success;
- }
- else {
- print << ".";
-*** Could not find a version $ver or above for $pkg; skipping.
-.
- }
-
- MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
- }
-
- return $installed;
-}
-
-sub _has_cpanplus {
- return (
- $HasCPANPLUS = (
- $INC{'CPANPLUS/Config.pm'}
- or _load('CPANPLUS::Shell::Default')
- )
- );
-}
-
-# make guesses on whether we're under the CPAN installation directory
-sub _under_cpan {
- require Cwd;
- require File::Spec;
-
- my $cwd = File::Spec->canonpath( Cwd::cwd() );
- my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
-
- return ( index( $cwd, $cpan ) > -1 );
-}
-
-sub _update_to {
- my $class = __PACKAGE__;
- my $ver = shift;
-
- return
- if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade
-
- if (
- _prompt( "==> A newer version of $class ($ver) is required. Install?",
- 'y' ) =~ /^[Nn]/
- )
- {
- die "*** Please install $class $ver manually.\n";
- }
-
- print << ".";
-*** Trying to fetch it from CPAN...
-.
-
- # install ourselves
- _load($class) and return $class->import(@_)
- if $class->install( [], $class, $ver );
-
- print << '.'; exit 1;
-
-*** Cannot bootstrap myself. :-( Installation terminated.
-.
-}
-
-# check if we're connected to some host, using inet_aton
-sub _connected_to {
- my $site = shift;
-
- return (
- ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
- qq(
-*** Your host cannot resolve the domain name '$site', which
- probably means the Internet connections are unavailable.
-==> Should we try to install the required module(s) anyway?), 'n'
- ) =~ /^[Yy]/
- );
-}
-
-# check if a directory is writable; may create it on demand
-sub _can_write {
- my $path = shift;
- mkdir( $path, 0755 ) unless -e $path;
-
- return 1 if -w $path;
-
- print << ".";
-*** You are not allowed to write to the directory '$path';
- the installation may fail due to insufficient permissions.
-.
-
- if (
- eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
- qq(
-==> Should we try to re-execute the autoinstall process with 'sudo'?),
- ((-t STDIN) ? 'y' : 'n')
- ) =~ /^[Yy]/
- )
- {
-
- # try to bootstrap ourselves from sudo
- print << ".";
-*** Trying to re-execute the autoinstall process with 'sudo'...
-.
- my $missing = join( ',', @Missing );
- my $config = join( ',',
- UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- if $Config;
-
- return
- unless system( 'sudo', $^X, $0, "--config=$config",
- "--installdeps=$missing" );
-
- print << ".";
-*** The 'sudo' command exited with error! Resuming...
-.
- }
-
- return _prompt(
- qq(
-==> Should we try to install the required module(s) anyway?), 'n'
- ) =~ /^[Yy]/;
-}
-
-# load a module and return the version it reports
-sub _load {
- my $mod = pop; # method/function doesn't matter
- my $file = $mod;
- $file =~ s|::|/|g;
- $file .= '.pm';
- local $@;
- return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
-}
-
-# report version without loading a module
-sub _version_of {
- my $mod = pop; # method/function doesn't matter
- my $file = $mod;
- $file =~ s|::|/|g;
- $file .= '.pm';
- foreach my $dir ( @INC ) {
- next if ref $dir;
- my $path = File::Spec->catfile($dir, $file);
- next unless -e $path;
- require ExtUtils::MM_Unix;
- return ExtUtils::MM_Unix->parse_version($path);
- }
- return undef;
-}
-
-# Load CPAN.pm and it's configuration
-sub _load_cpan {
- return if $CPAN::VERSION and $CPAN::Config and not @_;
- require CPAN;
-
- # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
- # CPAN::HandleConfig->load. CPAN reports that the redirection
- # is deprecated in a warning printed at the user.
-
- # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
- # $CPAN::HandleConfig::VERSION but cannot handle
- # CPAN::Config->load
-
- # Which "versions expect CPAN::Config->load?
-
- if ( $CPAN::HandleConfig::VERSION
- || CPAN::HandleConfig->can('load')
- ) {
- # Newer versions of CPAN have a HandleConfig module
- CPAN::HandleConfig->load;
- } else {
- # Older versions had the load method in Config directly
- CPAN::Config->load;
- }
-}
-
-# compare two versions, either use Sort::Versions or plain comparison
-# return values same as <=>
-sub _version_cmp {
- my ( $cur, $min ) = @_;
- return -1 unless defined $cur; # if 0 keep comparing
- return 1 unless $min;
-
- $cur =~ s/\s+$//;
-
- # check for version numbers that are not in decimal format
- if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
- if ( ( $version::VERSION or defined( _load('version') )) and
- version->can('new')
- ) {
-
- # use version.pm if it is installed.
- return version->new($cur) <=> version->new($min);
- }
- elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
- {
-
- # use Sort::Versions as the sorting algorithm for a.b.c versions
- return Sort::Versions::versioncmp( $cur, $min );
- }
-
- warn "Cannot reliably compare non-decimal formatted versions.\n"
- . "Please install version.pm or Sort::Versions.\n";
- }
-
- # plain comparison
- local $^W = 0; # shuts off 'not numeric' bugs
- return $cur <=> $min;
-}
-
-# nothing; this usage is deprecated.
-sub main::PREREQ_PM { return {}; }
-
-sub _make_args {
- my %args = @_;
-
- $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
- if $UnderCPAN or $TestOnly;
-
- if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
- require ExtUtils::Manifest;
- my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
-
- $args{EXE_FILES} =
- [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
- }
-
- $args{test}{TESTS} ||= 't/*.t';
- $args{test}{TESTS} = join( ' ',
- grep { !exists( $DisabledTests{$_} ) }
- map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
-
- my $missing = join( ',', @Missing );
- my $config =
- join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- if $Config;
-
- $PostambleActions = (
- ($missing and not $UnderCPAN)
- ? "\$(PERL) $0 --config=$config --installdeps=$missing"
- : "\$(NOECHO) \$(NOOP)"
- );
-
- my $deps_list = join( ',', @Missing, @Existing );
-
- $PostambleActionsUpgradeDeps =
- "\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
-
- my $config_notest =
- join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
- 'notest', 1 )
- if $Config;
-
- $PostambleActionsNoTest = (
- ($missing and not $UnderCPAN)
- ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
- : "\$(NOECHO) \$(NOOP)"
- );
-
- $PostambleActionsUpgradeDepsNoTest =
- "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
-
- $PostambleActionsListDeps =
- '@$(PERL) -le "print for @ARGV" '
- . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
-
- my @all = (@Missing, @Existing);
-
- $PostambleActionsListAllDeps =
- '@$(PERL) -le "print for @ARGV" '
- . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
-
- return %args;
-}
-
-# a wrapper to ExtUtils::MakeMaker::WriteMakefile
-sub Write {
- require Carp;
- Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
-
- if ($CheckOnly) {
- print << ".";
-*** Makefile not written in check-only mode.
-.
- return;
- }
-
- my %args = _make_args(@_);
-
- no strict 'refs';
-
- $PostambleUsed = 0;
- local *MY::postamble = \&postamble unless defined &MY::postamble;
- ExtUtils::MakeMaker::WriteMakefile(%args);
-
- print << "." unless $PostambleUsed;
-*** WARNING: Makefile written with customized MY::postamble() without
- including contents from Module::AutoInstall::postamble() --
- auto installation features disabled. Please contact the author.
-.
-
- return 1;
-}
-
-sub postamble {
- $PostambleUsed = 1;
- my $fragment;
-
- $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
-
-config :: installdeps
-\t\$(NOECHO) \$(NOOP)
-AUTO_INSTALL
-
- $fragment .= <<"END_MAKE";
-
-checkdeps ::
-\t\$(PERL) $0 --checkdeps
-
-installdeps ::
-\t$PostambleActions
-
-installdeps_notest ::
-\t$PostambleActionsNoTest
-
-upgradedeps ::
-\t$PostambleActionsUpgradeDeps
-
-upgradedeps_notest ::
-\t$PostambleActionsUpgradeDepsNoTest
-
-listdeps ::
-\t$PostambleActionsListDeps
-
-listalldeps ::
-\t$PostambleActionsListAllDeps
-
-END_MAKE
-
- return $fragment;
-}
-
-1;
-
-__END__
-
-#line 1193
@@ -1,93 +0,0 @@
-#line 1
-package Module::Install::AutoInstall;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.06';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub AutoInstall { $_[0] }
-
-sub run {
- my $self = shift;
- $self->auto_install_now(@_);
-}
-
-sub write {
- my $self = shift;
- $self->auto_install(@_);
-}
-
-sub auto_install {
- my $self = shift;
- return if $self->{done}++;
-
- # Flatten array of arrays into a single array
- my @core = map @$_, map @$_, grep ref,
- $self->build_requires, $self->requires;
-
- my @config = @_;
-
- # We'll need Module::AutoInstall
- $self->include('Module::AutoInstall');
- require Module::AutoInstall;
-
- my @features_require = Module::AutoInstall->import(
- (@config ? (-config => \@config) : ()),
- (@core ? (-core => \@core) : ()),
- $self->features,
- );
-
- my %seen;
- my @requires = map @$_, map @$_, grep ref, $self->requires;
- while (my ($mod, $ver) = splice(@requires, 0, 2)) {
- $seen{$mod}{$ver}++;
- }
- my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
- while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
- $seen{$mod}{$ver}++;
- }
- my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
- while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
- $seen{$mod}{$ver}++;
- }
-
- my @deduped;
- while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
- push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
- }
-
- $self->requires(@deduped);
-
- $self->makemaker_args( Module::AutoInstall::_make_args() );
-
- my $class = ref($self);
- $self->postamble(
- "# --- $class section:\n" .
- Module::AutoInstall::postamble()
- );
-}
-
-sub installdeps_target {
- my ($self, @args) = @_;
-
- $self->include('Module::AutoInstall');
- require Module::AutoInstall;
-
- Module::AutoInstall::_installdeps_target(1);
-
- $self->auto_install(@args);
-}
-
-sub auto_install_now {
- my $self = shift;
- $self->auto_install(@_);
- Module::AutoInstall::do_install();
-}
-
-1;
@@ -1,83 +0,0 @@
-#line 1
-package Module::Install::Base;
-
-use strict 'vars';
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '1.06';
-}
-
-# Suspend handler for "redefined" warnings
-BEGIN {
- my $w = $SIG{__WARN__};
- $SIG{__WARN__} = sub { $w };
-}
-
-#line 42
-
-sub new {
- my $class = shift;
- unless ( defined &{"${class}::call"} ) {
- *{"${class}::call"} = sub { shift->_top->call(@_) };
- }
- unless ( defined &{"${class}::load"} ) {
- *{"${class}::load"} = sub { shift->_top->load(@_) };
- }
- bless { @_ }, $class;
-}
-
-#line 61
-
-sub AUTOLOAD {
- local $@;
- my $func = eval { shift->_top->autoload } or return;
- goto &$func;
-}
-
-#line 75
-
-sub _top {
- $_[0]->{_top};
-}
-
-#line 90
-
-sub admin {
- $_[0]->_top->{admin}
- or
- Module::Install::Base::FakeAdmin->new;
-}
-
-#line 106
-
-sub is_admin {
- ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
-}
-
-sub DESTROY {}
-
-package Module::Install::Base::FakeAdmin;
-
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = $Module::Install::Base::VERSION;
-}
-
-my $fake;
-
-sub new {
- $fake ||= bless(\@_, $_[0]);
-}
-
-sub AUTOLOAD {}
-
-sub DESTROY {}
-
-# Restore warning handler
-BEGIN {
- $SIG{__WARN__} = $SIG{__WARN__}->();
-}
-
-1;
-
-#line 159
@@ -1,154 +0,0 @@
-#line 1
-package Module::Install::Can;
-
-use strict;
-use Config ();
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.06';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-# check if we can load some module
-### Upgrade this to not have to load the module if possible
-sub can_use {
- my ($self, $mod, $ver) = @_;
- $mod =~ s{::|\\}{/}g;
- $mod .= '.pm' unless $mod =~ /\.pm$/i;
-
- my $pkg = $mod;
- $pkg =~ s{/}{::}g;
- $pkg =~ s{\.pm$}{}i;
-
- local $@;
- eval { require $mod; $pkg->VERSION($ver || 0); 1 };
-}
-
-# Check if we can run some command
-sub can_run {
- my ($self, $cmd) = @_;
-
- my $_cmd = $cmd;
- return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
-
- for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
- next if $dir eq '';
- require File::Spec;
- my $abs = File::Spec->catfile($dir, $cmd);
- return $abs if (-x $abs or $abs = MM->maybe_command($abs));
- }
-
- return;
-}
-
-# Can our C compiler environment build XS files
-sub can_xs {
- my $self = shift;
-
- # Ensure we have the CBuilder module
- $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
-
- # Do we have the configure_requires checker?
- local $@;
- eval "require ExtUtils::CBuilder;";
- if ( $@ ) {
- # They don't obey configure_requires, so it is
- # someone old and delicate. Try to avoid hurting
- # them by falling back to an older simpler test.
- return $self->can_cc();
- }
-
- # Do we have a working C compiler
- my $builder = ExtUtils::CBuilder->new(
- quiet => 1,
- );
- unless ( $builder->have_compiler ) {
- # No working C compiler
- return 0;
- }
-
- # Write a C file representative of what XS becomes
- require File::Temp;
- my ( $FH, $tmpfile ) = File::Temp::tempfile(
- "compilexs-XXXXX",
- SUFFIX => '.c',
- );
- binmode $FH;
- print $FH <<'END_C';
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-int main(int argc, char **argv) {
- return 0;
-}
-
-int boot_sanexs() {
- return 1;
-}
-
-END_C
- close $FH;
-
- # Can the C compiler access the same headers XS does
- my @libs = ();
- my $object = undef;
- eval {
- local $^W = 0;
- $object = $builder->compile(
- source => $tmpfile,
- );
- @libs = $builder->link(
- objects => $object,
- module_name => 'sanexs',
- );
- };
- my $result = $@ ? 0 : 1;
-
- # Clean up all the build files
- foreach ( $tmpfile, $object, @libs ) {
- next unless defined $_;
- 1 while unlink;
- }
-
- return $result;
-}
-
-# Can we locate a (the) C compiler
-sub can_cc {
- my $self = shift;
- my @chunks = split(/ /, $Config::Config{cc}) or return;
-
- # $Config{cc} may contain args; try to find out the program part
- while (@chunks) {
- return $self->can_run("@chunks") || (pop(@chunks), next);
- }
-
- return;
-}
-
-# Fix Cygwin bug on maybe_command();
-if ( $^O eq 'cygwin' ) {
- require ExtUtils::MM_Cygwin;
- require ExtUtils::MM_Win32;
- if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
- *ExtUtils::MM_Cygwin::maybe_command = sub {
- my ($self, $file) = @_;
- if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
- ExtUtils::MM_Win32->maybe_command($file);
- } else {
- ExtUtils::MM_Unix->maybe_command($file);
- }
- }
- }
-}
-
-1;
-
-__END__
-
-#line 236
@@ -1,34 +0,0 @@
-#line 1
-package Module::Install::Include;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.06';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub include {
- shift()->admin->include(@_);
-}
-
-sub include_deps {
- shift()->admin->include_deps(@_);
-}
-
-sub auto_include {
- shift()->admin->auto_include(@_);
-}
-
-sub auto_include_deps {
- shift()->admin->auto_include_deps(@_);
-}
-
-sub auto_include_dependent_dists {
- shift()->admin->auto_include_dependent_dists(@_);
-}
-
-1;
@@ -1,56 +0,0 @@
-#line 1
-package Module::Install::MakeMaker;
-
-use strict;
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.06';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-my $makefile = undef;
-
-sub WriteMakefile {
- my ($self, %args) = @_;
- $makefile = $self->load('Makefile');
-
- # mapping between MakeMaker and META.yml keys
- $args{MODULE_NAME} = $args{NAME};
- unless ( $args{NAME} = $args{DISTNAME} or ! $args{MODULE_NAME} ) {
- $args{NAME} = $args{MODULE_NAME};
- $args{NAME} =~ s/::/-/g;
- }
-
- foreach my $key ( qw{name module_name version version_from abstract author installdirs} ) {
- my $value = delete($args{uc($key)}) or next;
- $self->$key($value);
- }
-
- if (my $prereq = delete($args{PREREQ_PM})) {
- while (my($k,$v) = each %$prereq) {
- $self->requires($k,$v);
- }
- }
-
- if (my $prereq = delete($args{BUILD_REQUIRES})) {
- while (my($k,$v) = each %$prereq) {
- $self->build_requires($k,$v);
- }
- }
-
- # put the remaining args to makemaker_args
- $self->makemaker_args(%args);
-}
-
-END {
- if ( $makefile ) {
- $makefile->write;
- $makefile->Meta->write;
- }
-}
-
-1;
@@ -1,418 +0,0 @@
-#line 1
-package Module::Install::Makefile;
-
-use strict 'vars';
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
-use Fcntl qw/:flock :seek/;
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.06';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub Makefile { $_[0] }
-
-my %seen = ();
-
-sub prompt {
- shift;
-
- # Infinite loop protection
- my @c = caller();
- if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
- die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
- }
-
- # In automated testing or non-interactive session, always use defaults
- if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
- local $ENV{PERL_MM_USE_DEFAULT} = 1;
- goto &ExtUtils::MakeMaker::prompt;
- } else {
- goto &ExtUtils::MakeMaker::prompt;
- }
-}
-
-# Store a cleaned up version of the MakeMaker version,
-# since we need to behave differently in a variety of
-# ways based on the MM version.
-my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
-
-# If we are passed a param, do a "newer than" comparison.
-# Otherwise, just return the MakeMaker version.
-sub makemaker {
- ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
-}
-
-# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
-# as we only need to know here whether the attribute is an array
-# or a hash or something else (which may or may not be appendable).
-my %makemaker_argtype = (
- C => 'ARRAY',
- CONFIG => 'ARRAY',
-# CONFIGURE => 'CODE', # ignore
- DIR => 'ARRAY',
- DL_FUNCS => 'HASH',
- DL_VARS => 'ARRAY',
- EXCLUDE_EXT => 'ARRAY',
- EXE_FILES => 'ARRAY',
- FUNCLIST => 'ARRAY',
- H => 'ARRAY',
- IMPORTS => 'HASH',
- INCLUDE_EXT => 'ARRAY',
- LIBS => 'ARRAY', # ignore ''
- MAN1PODS => 'HASH',
- MAN3PODS => 'HASH',
- META_ADD => 'HASH',
- META_MERGE => 'HASH',
- PL_FILES => 'HASH',
- PM => 'HASH',
- PMLIBDIRS => 'ARRAY',
- PMLIBPARENTDIRS => 'ARRAY',
- PREREQ_PM => 'HASH',
- CONFIGURE_REQUIRES => 'HASH',
- SKIP => 'ARRAY',
- TYPEMAPS => 'ARRAY',
- XS => 'HASH',
-# VERSION => ['version',''], # ignore
-# _KEEP_AFTER_FLUSH => '',
-
- clean => 'HASH',
- depend => 'HASH',
- dist => 'HASH',
- dynamic_lib=> 'HASH',
- linkext => 'HASH',
- macro => 'HASH',
- postamble => 'HASH',
- realclean => 'HASH',
- test => 'HASH',
- tool_autosplit => 'HASH',
-
- # special cases where you can use makemaker_append
- CCFLAGS => 'APPENDABLE',
- DEFINE => 'APPENDABLE',
- INC => 'APPENDABLE',
- LDDLFLAGS => 'APPENDABLE',
- LDFROM => 'APPENDABLE',
-);
-
-sub makemaker_args {
- my ($self, %new_args) = @_;
- my $args = ( $self->{makemaker_args} ||= {} );
- foreach my $key (keys %new_args) {
- if ($makemaker_argtype{$key}) {
- if ($makemaker_argtype{$key} eq 'ARRAY') {
- $args->{$key} = [] unless defined $args->{$key};
- unless (ref $args->{$key} eq 'ARRAY') {
- $args->{$key} = [$args->{$key}]
- }
- push @{$args->{$key}},
- ref $new_args{$key} eq 'ARRAY'
- ? @{$new_args{$key}}
- : $new_args{$key};
- }
- elsif ($makemaker_argtype{$key} eq 'HASH') {
- $args->{$key} = {} unless defined $args->{$key};
- foreach my $skey (keys %{ $new_args{$key} }) {
- $args->{$key}{$skey} = $new_args{$key}{$skey};
- }
- }
- elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
- $self->makemaker_append($key => $new_args{$key});
- }
- }
- else {
- if (defined $args->{$key}) {
- warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
- }
- $args->{$key} = $new_args{$key};
- }
- }
- return $args;
-}
-
-# For mm args that take multiple space-seperated args,
-# append an argument to the current list.
-sub makemaker_append {
- my $self = shift;
- my $name = shift;
- my $args = $self->makemaker_args;
- $args->{$name} = defined $args->{$name}
- ? join( ' ', $args->{$name}, @_ )
- : join( ' ', @_ );
-}
-
-sub build_subdirs {
- my $self = shift;
- my $subdirs = $self->makemaker_args->{DIR} ||= [];
- for my $subdir (@_) {
- push @$subdirs, $subdir;
- }
-}
-
-sub clean_files {
- my $self = shift;
- my $clean = $self->makemaker_args->{clean} ||= {};
- %$clean = (
- %$clean,
- FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
- );
-}
-
-sub realclean_files {
- my $self = shift;
- my $realclean = $self->makemaker_args->{realclean} ||= {};
- %$realclean = (
- %$realclean,
- FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
- );
-}
-
-sub libs {
- my $self = shift;
- my $libs = ref $_[0] ? shift : [ shift ];
- $self->makemaker_args( LIBS => $libs );
-}
-
-sub inc {
- my $self = shift;
- $self->makemaker_args( INC => shift );
-}
-
-sub _wanted_t {
-}
-
-sub tests_recursive {
- my $self = shift;
- my $dir = shift || 't';
- unless ( -d $dir ) {
- die "tests_recursive dir '$dir' does not exist";
- }
- my %tests = map { $_ => 1 } split / /, ($self->tests || '');
- require File::Find;
- File::Find::find(
- sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
- $dir
- );
- $self->tests( join ' ', sort keys %tests );
-}
-
-sub write {
- my $self = shift;
- die "&Makefile->write() takes no arguments\n" if @_;
-
- # Check the current Perl version
- my $perl_version = $self->perl_version;
- if ( $perl_version ) {
- eval "use $perl_version; 1"
- or die "ERROR: perl: Version $] is installed, "
- . "but we need version >= $perl_version";
- }
-
- # Make sure we have a new enough MakeMaker
- require ExtUtils::MakeMaker;
-
- if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
- # This previous attempted to inherit the version of
- # ExtUtils::MakeMaker in use by the module author, but this
- # was found to be untenable as some authors build releases
- # using future dev versions of EU:MM that nobody else has.
- # Instead, #toolchain suggests we use 6.59 which is the most
- # stable version on CPAN at time of writing and is, to quote
- # ribasushi, "not terminally fucked, > and tested enough".
- # TODO: We will now need to maintain this over time to push
- # the version up as new versions are released.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
- $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
- } else {
- # Allow legacy-compatibility with 5.005 by depending on the
- # most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
- $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
- }
-
- # Generate the MakeMaker params
- my $args = $self->makemaker_args;
- $args->{DISTNAME} = $self->name;
- $args->{NAME} = $self->module_name || $self->name;
- $args->{NAME} =~ s/-/::/g;
- $args->{VERSION} = $self->version or die <<'EOT';
-ERROR: Can't determine distribution version. Please specify it
-explicitly via 'version' in Makefile.PL, or set a valid $VERSION
-in a module, and provide its file path via 'version_from' (or
-'all_from' if you prefer) in Makefile.PL.
-EOT
-
- if ( $self->tests ) {
- my @tests = split ' ', $self->tests;
- my %seen;
- $args->{test} = {
- TESTS => (join ' ', grep {!$seen{$_}++} @tests),
- };
- } elsif ( $Module::Install::ExtraTests::use_extratests ) {
- # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
- # So, just ignore our xt tests here.
- } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
- $args->{test} = {
- TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
- };
- }
- if ( $] >= 5.005 ) {
- $args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = join ', ', @{$self->author || []};
- }
- if ( $self->makemaker(6.10) ) {
- $args->{NO_META} = 1;
- #$args->{NO_MYMETA} = 1;
- }
- if ( $self->makemaker(6.17) and $self->sign ) {
- $args->{SIGN} = 1;
- }
- unless ( $self->is_admin ) {
- delete $args->{SIGN};
- }
- if ( $self->makemaker(6.31) and $self->license ) {
- $args->{LICENSE} = $self->license;
- }
-
- my $prereq = ($args->{PREREQ_PM} ||= {});
- %$prereq = ( %$prereq,
- map { @$_ } # flatten [module => version]
- map { @$_ }
- grep $_,
- ($self->requires)
- );
-
- # Remove any reference to perl, PREREQ_PM doesn't support it
- delete $args->{PREREQ_PM}->{perl};
-
- # Merge both kinds of requires into BUILD_REQUIRES
- my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
- %$build_prereq = ( %$build_prereq,
- map { @$_ } # flatten [module => version]
- map { @$_ }
- grep $_,
- ($self->configure_requires, $self->build_requires)
- );
-
- # Remove any reference to perl, BUILD_REQUIRES doesn't support it
- delete $args->{BUILD_REQUIRES}->{perl};
-
- # Delete bundled dists from prereq_pm, add it to Makefile DIR
- my $subdirs = ($args->{DIR} || []);
- if ($self->bundles) {
- my %processed;
- foreach my $bundle (@{ $self->bundles }) {
- my ($mod_name, $dist_dir) = @$bundle;
- delete $prereq->{$mod_name};
- $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
- if (not exists $processed{$dist_dir}) {
- if (-d $dist_dir) {
- # List as sub-directory to be processed by make
- push @$subdirs, $dist_dir;
- }
- # Else do nothing: the module is already present on the system
- $processed{$dist_dir} = undef;
- }
- }
- }
-
- unless ( $self->makemaker('6.55_03') ) {
- %$prereq = (%$prereq,%$build_prereq);
- delete $args->{BUILD_REQUIRES};
- }
-
- if ( my $perl_version = $self->perl_version ) {
- eval "use $perl_version; 1"
- or die "ERROR: perl: Version $] is installed, "
- . "but we need version >= $perl_version";
-
- if ( $self->makemaker(6.48) ) {
- $args->{MIN_PERL_VERSION} = $perl_version;
- }
- }
-
- if ($self->installdirs) {
- warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
- $args->{INSTALLDIRS} = $self->installdirs;
- }
-
- my %args = map {
- ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
- } keys %$args;
-
- my $user_preop = delete $args{dist}->{PREOP};
- if ( my $preop = $self->admin->preop($user_preop) ) {
- foreach my $key ( keys %$preop ) {
- $args{dist}->{$key} = $preop->{$key};
- }
- }
-
- my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
- $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
-}
-
-sub fix_up_makefile {
- my $self = shift;
- my $makefile_name = shift;
- my $top_class = ref($self->_top) || '';
- my $top_version = $self->_top->VERSION || '';
-
- my $preamble = $self->preamble
- ? "# Preamble by $top_class $top_version\n"
- . $self->preamble
- : '';
- my $postamble = "# Postamble by $top_class $top_version\n"
- . ($self->postamble || '');
-
- local *MAKEFILE;
- open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
- eval { flock MAKEFILE, LOCK_EX };
- my $makefile = do { local $/; <MAKEFILE> };
-
- $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
- $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
- $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
- $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
- $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
-
- # Module::Install will never be used to build the Core Perl
- # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
- # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
- $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
- #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
-
- # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
- $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
-
- # XXX - This is currently unused; not sure if it breaks other MM-users
- # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
-
- seek MAKEFILE, 0, SEEK_SET;
- truncate MAKEFILE, 0;
- print MAKEFILE "$preamble$makefile$postamble" or die $!;
- close MAKEFILE or die $!;
-
- 1;
-}
-
-sub preamble {
- my ($self, $text) = @_;
- $self->{preamble} = $text . $self->{preamble} if defined $text;
- $self->{preamble};
-}
-
-sub postamble {
- my ($self, $text) = @_;
- $self->{postamble} ||= $self->admin->postamble;
- $self->{postamble} .= $text if defined $text;
- $self->{postamble}
-}
-
-1;
-
-__END__
-
-#line 544
@@ -1,722 +0,0 @@
-#line 1
-package Module::Install::Metadata;
-
-use strict 'vars';
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.06';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-my @boolean_keys = qw{
- sign
-};
-
-my @scalar_keys = qw{
- name
- module_name
- abstract
- version
- distribution_type
- tests
- installdirs
-};
-
-my @tuple_keys = qw{
- configure_requires
- build_requires
- requires
- recommends
- bundles
- resources
-};
-
-my @resource_keys = qw{
- homepage
- bugtracker
- repository
-};
-
-my @array_keys = qw{
- keywords
- author
-};
-
-*authors = \&author;
-
-sub Meta { shift }
-sub Meta_BooleanKeys { @boolean_keys }
-sub Meta_ScalarKeys { @scalar_keys }
-sub Meta_TupleKeys { @tuple_keys }
-sub Meta_ResourceKeys { @resource_keys }
-sub Meta_ArrayKeys { @array_keys }
-
-foreach my $key ( @boolean_keys ) {
- *$key = sub {
- my $self = shift;
- if ( defined wantarray and not @_ ) {
- return $self->{values}->{$key};
- }
- $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
- return $self;
- };
-}
-
-foreach my $key ( @scalar_keys ) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} if defined wantarray and !@_;
- $self->{values}->{$key} = shift;
- return $self;
- };
-}
-
-foreach my $key ( @array_keys ) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} if defined wantarray and !@_;
- $self->{values}->{$key} ||= [];
- push @{$self->{values}->{$key}}, @_;
- return $self;
- };
-}
-
-foreach my $key ( @resource_keys ) {
- *$key = sub {
- my $self = shift;
- unless ( @_ ) {
- return () unless $self->{values}->{resources};
- return map { $_->[1] }
- grep { $_->[0] eq $key }
- @{ $self->{values}->{resources} };
- }
- return $self->{values}->{resources}->{$key} unless @_;
- my $uri = shift or die(
- "Did not provide a value to $key()"
- );
- $self->resources( $key => $uri );
- return 1;
- };
-}
-
-foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} unless @_;
- my @added;
- while ( @_ ) {
- my $module = shift or last;
- my $version = shift || 0;
- push @added, [ $module, $version ];
- }
- push @{ $self->{values}->{$key} }, @added;
- return map {@$_} @added;
- };
-}
-
-# Resource handling
-my %lc_resource = map { $_ => 1 } qw{
- homepage
- license
- bugtracker
- repository
-};
-
-sub resources {
- my $self = shift;
- while ( @_ ) {
- my $name = shift or last;
- my $value = shift or next;
- if ( $name eq lc $name and ! $lc_resource{$name} ) {
- die("Unsupported reserved lowercase resource '$name'");
- }
- $self->{values}->{resources} ||= [];
- push @{ $self->{values}->{resources} }, [ $name, $value ];
- }
- $self->{values}->{resources};
-}
-
-# Aliases for build_requires that will have alternative
-# meanings in some future version of META.yml.
-sub test_requires { shift->build_requires(@_) }
-sub install_requires { shift->build_requires(@_) }
-
-# Aliases for installdirs options
-sub install_as_core { $_[0]->installdirs('perl') }
-sub install_as_cpan { $_[0]->installdirs('site') }
-sub install_as_site { $_[0]->installdirs('site') }
-sub install_as_vendor { $_[0]->installdirs('vendor') }
-
-sub dynamic_config {
- my $self = shift;
- my $value = @_ ? shift : 1;
- if ( $self->{values}->{dynamic_config} ) {
- # Once dynamic we never change to static, for safety
- return 0;
- }
- $self->{values}->{dynamic_config} = $value ? 1 : 0;
- return 1;
-}
-
-# Convenience command
-sub static_config {
- shift->dynamic_config(0);
-}
-
-sub perl_version {
- my $self = shift;
- return $self->{values}->{perl_version} unless @_;
- my $version = shift or die(
- "Did not provide a value to perl_version()"
- );
-
- # Normalize the version
- $version = $self->_perl_version($version);
-
- # We don't support the really old versions
- unless ( $version >= 5.005 ) {
- die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
- }
-
- $self->{values}->{perl_version} = $version;
-}
-
-sub all_from {
- my ( $self, $file ) = @_;
-
- unless ( defined($file) ) {
- my $name = $self->name or die(
- "all_from called with no args without setting name() first"
- );
- $file = join('/', 'lib', split(/-/, $name)) . '.pm';
- $file =~ s{.*/}{} unless -e $file;
- unless ( -e $file ) {
- die("all_from cannot find $file from $name");
- }
- }
- unless ( -f $file ) {
- die("The path '$file' does not exist, or is not a file");
- }
-
- $self->{values}{all_from} = $file;
-
- # Some methods pull from POD instead of code.
- # If there is a matching .pod, use that instead
- my $pod = $file;
- $pod =~ s/\.pm$/.pod/i;
- $pod = $file unless -e $pod;
-
- # Pull the different values
- $self->name_from($file) unless $self->name;
- $self->version_from($file) unless $self->version;
- $self->perl_version_from($file) unless $self->perl_version;
- $self->author_from($pod) unless @{$self->author || []};
- $self->license_from($pod) unless $self->license;
- $self->abstract_from($pod) unless $self->abstract;
-
- return 1;
-}
-
-sub provides {
- my $self = shift;
- my $provides = ( $self->{values}->{provides} ||= {} );
- %$provides = (%$provides, @_) if @_;
- return $provides;
-}
-
-sub auto_provides {
- my $self = shift;
- return $self unless $self->is_admin;
- unless (-e 'MANIFEST') {
- warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
- return $self;
- }
- # Avoid spurious warnings as we are not checking manifest here.
- local $SIG{__WARN__} = sub {1};
- require ExtUtils::Manifest;
- local *ExtUtils::Manifest::manicheck = sub { return };
-
- require Module::Build;
- my $build = Module::Build->new(
- dist_name => $self->name,
- dist_version => $self->version,
- license => $self->license,
- );
- $self->provides( %{ $build->find_dist_packages || {} } );
-}
-
-sub feature {
- my $self = shift;
- my $name = shift;
- my $features = ( $self->{values}->{features} ||= [] );
- my $mods;
-
- if ( @_ == 1 and ref( $_[0] ) ) {
- # The user used ->feature like ->features by passing in the second
- # argument as a reference. Accomodate for that.
- $mods = $_[0];
- } else {
- $mods = \@_;
- }
-
- my $count = 0;
- push @$features, (
- $name => [
- map {
- ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
- } @$mods
- ]
- );
-
- return @$features;
-}
-
-sub features {
- my $self = shift;
- while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
- $self->feature( $name, @$mods );
- }
- return $self->{values}->{features}
- ? @{ $self->{values}->{features} }
- : ();
-}
-
-sub no_index {
- my $self = shift;
- my $type = shift;
- push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
- return $self->{values}->{no_index};
-}
-
-sub read {
- my $self = shift;
- $self->include_deps( 'YAML::Tiny', 0 );
-
- require YAML::Tiny;
- my $data = YAML::Tiny::LoadFile('META.yml');
-
- # Call methods explicitly in case user has already set some values.
- while ( my ( $key, $value ) = each %$data ) {
- next unless $self->can($key);
- if ( ref $value eq 'HASH' ) {
- while ( my ( $module, $version ) = each %$value ) {
- $self->can($key)->($self, $module => $version );
- }
- } else {
- $self->can($key)->($self, $value);
- }
- }
- return $self;
-}
-
-sub write {
- my $self = shift;
- return $self unless $self->is_admin;
- $self->admin->write_meta;
- return $self;
-}
-
-sub version_from {
- require ExtUtils::MM_Unix;
- my ( $self, $file ) = @_;
- $self->version( ExtUtils::MM_Unix->parse_version($file) );
-
- # for version integrity check
- $self->makemaker_args( VERSION_FROM => $file );
-}
-
-sub abstract_from {
- require ExtUtils::MM_Unix;
- my ( $self, $file ) = @_;
- $self->abstract(
- bless(
- { DISTNAME => $self->name },
- 'ExtUtils::MM_Unix'
- )->parse_abstract($file)
- );
-}
-
-# Add both distribution and module name
-sub name_from {
- my ($self, $file) = @_;
- if (
- Module::Install::_read($file) =~ m/
- ^ \s*
- package \s*
- ([\w:]+)
- \s* ;
- /ixms
- ) {
- my ($name, $module_name) = ($1, $1);
- $name =~ s{::}{-}g;
- $self->name($name);
- unless ( $self->module_name ) {
- $self->module_name($module_name);
- }
- } else {
- die("Cannot determine name from $file\n");
- }
-}
-
-sub _extract_perl_version {
- if (
- $_[0] =~ m/
- ^\s*
- (?:use|require) \s*
- v?
- ([\d_\.]+)
- \s* ;
- /ixms
- ) {
- my $perl_version = $1;
- $perl_version =~ s{_}{}g;
- return $perl_version;
- } else {
- return;
- }
-}
-
-sub perl_version_from {
- my $self = shift;
- my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
- if ($perl_version) {
- $self->perl_version($perl_version);
- } else {
- warn "Cannot determine perl version info from $_[0]\n";
- return;
- }
-}
-
-sub author_from {
- my $self = shift;
- my $content = Module::Install::_read($_[0]);
- if ($content =~ m/
- =head \d \s+ (?:authors?)\b \s*
- ([^\n]*)
- |
- =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
- .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
- ([^\n]*)
- /ixms) {
- my $author = $1 || $2;
-
- # XXX: ugly but should work anyway...
- if (eval "require Pod::Escapes; 1") {
- # Pod::Escapes has a mapping table.
- # It's in core of perl >= 5.9.3, and should be installed
- # as one of the Pod::Simple's prereqs, which is a prereq
- # of Pod::Text 3.x (see also below).
- $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
- {
- defined $2
- ? chr($2)
- : defined $Pod::Escapes::Name2character_number{$1}
- ? chr($Pod::Escapes::Name2character_number{$1})
- : do {
- warn "Unknown escape: E<$1>";
- "E<$1>";
- };
- }gex;
- }
- elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
- # Pod::Text < 3.0 has yet another mapping table,
- # though the table name of 2.x and 1.x are different.
- # (1.x is in core of Perl < 5.6, 2.x is in core of
- # Perl < 5.9.3)
- my $mapping = ($Pod::Text::VERSION < 2)
- ? \%Pod::Text::HTML_Escapes
- : \%Pod::Text::ESCAPES;
- $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
- {
- defined $2
- ? chr($2)
- : defined $mapping->{$1}
- ? $mapping->{$1}
- : do {
- warn "Unknown escape: E<$1>";
- "E<$1>";
- };
- }gex;
- }
- else {
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
- }
- $self->author($author);
- } else {
- warn "Cannot determine author info from $_[0]\n";
- }
-}
-
-#Stolen from M::B
-my %license_urls = (
- perl => 'http://dev.perl.org/licenses/',
- apache => 'http://apache.org/licenses/LICENSE-2.0',
- apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
- artistic => 'http://opensource.org/licenses/artistic-license.php',
- artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
- lgpl => 'http://opensource.org/licenses/lgpl-license.php',
- lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
- lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
- bsd => 'http://opensource.org/licenses/bsd-license.php',
- gpl => 'http://opensource.org/licenses/gpl-license.php',
- gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
- gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
- mit => 'http://opensource.org/licenses/mit-license.php',
- mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
- open_source => undef,
- unrestricted => undef,
- restrictive => undef,
- unknown => undef,
-);
-
-sub license {
- my $self = shift;
- return $self->{values}->{license} unless @_;
- my $license = shift or die(
- 'Did not provide a value to license()'
- );
- $license = __extract_license($license) || lc $license;
- $self->{values}->{license} = $license;
-
- # Automatically fill in license URLs
- if ( $license_urls{$license} ) {
- $self->resources( license => $license_urls{$license} );
- }
-
- return 1;
-}
-
-sub _extract_license {
- my $pod = shift;
- my $matched;
- return __extract_license(
- ($matched) = $pod =~ m/
- (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
- (=head \d.*|=cut.*|)\z
- /xms
- ) || __extract_license(
- ($matched) = $pod =~ m/
- (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
- (=head \d.*|=cut.*|)\z
- /xms
- );
-}
-
-sub __extract_license {
- my $license_text = shift or return;
- my @phrases = (
- '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
- '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
- 'Artistic and GPL' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'GNU Free Documentation license' => 'unrestricted', 1,
- 'GNU Affero General Public License' => 'open_source', 1,
- '(?:Free)?BSD license' => 'bsd', 1,
- 'Artistic license 2\.0' => 'artistic_2', 1,
- 'Artistic license' => 'artistic', 1,
- 'Apache (?:Software )?license' => 'apache', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'Mozilla Public License' => 'mozilla', 1,
- 'Q Public License' => 'open_source', 1,
- 'OpenSSL License' => 'unrestricted', 1,
- 'SSLeay License' => 'unrestricted', 1,
- 'zlib License' => 'open_source', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s#\s+#\\s+#gs;
- if ( $license_text =~ /\b$pattern\b/i ) {
- return $license;
- }
- }
- return '';
-}
-
-sub license_from {
- my $self = shift;
- if (my $license=_extract_license(Module::Install::_read($_[0]))) {
- $self->license($license);
- } else {
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
- }
-}
-
-sub _extract_bugtracker {
- my @links = $_[0] =~ m#L<(
- https?\Q://rt.cpan.org/\E[^>]+|
- https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
- https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
- )>#gx;
- my %links;
- @links{@links}=();
- @links=keys %links;
- return @links;
-}
-
-sub bugtracker_from {
- my $self = shift;
- my $content = Module::Install::_read($_[0]);
- my @links = _extract_bugtracker($content);
- unless ( @links ) {
- warn "Cannot determine bugtracker info from $_[0]\n";
- return 0;
- }
- if ( @links > 1 ) {
- warn "Found more than one bugtracker link in $_[0]\n";
- return 0;
- }
-
- # Set the bugtracker
- bugtracker( $links[0] );
- return 1;
-}
-
-sub requires_from {
- my $self = shift;
- my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
- while ( @requires ) {
- my $module = shift @requires;
- my $version = shift @requires;
- $self->requires( $module => $version );
- }
-}
-
-sub test_requires_from {
- my $self = shift;
- my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
- while ( @requires ) {
- my $module = shift @requires;
- my $version = shift @requires;
- $self->test_requires( $module => $version );
- }
-}
-
-# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
-# numbers (eg, 5.006001 or 5.008009).
-# Also, convert double-part versions (eg, 5.8)
-sub _perl_version {
- my $v = $_[-1];
- $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
- $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
- $v =~ s/(\.\d\d\d)000$/$1/;
- $v =~ s/_.+$//;
- if ( ref($v) ) {
- # Numify
- $v = $v + 0;
- }
- return $v;
-}
-
-sub add_metadata {
- my $self = shift;
- my %hash = @_;
- for my $key (keys %hash) {
- warn "add_metadata: $key is not prefixed with 'x_'.\n" .
- "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
- $self->{values}->{$key} = $hash{$key};
- }
-}
-
-
-######################################################################
-# MYMETA Support
-
-sub WriteMyMeta {
- die "WriteMyMeta has been deprecated";
-}
-
-sub write_mymeta_yaml {
- my $self = shift;
-
- # We need YAML::Tiny to write the MYMETA.yml file
- unless ( eval { require YAML::Tiny; 1; } ) {
- return 1;
- }
-
- # Generate the data
- my $meta = $self->_write_mymeta_data or return 1;
-
- # Save as the MYMETA.yml file
- print "Writing MYMETA.yml\n";
- YAML::Tiny::DumpFile('MYMETA.yml', $meta);
-}
-
-sub write_mymeta_json {
- my $self = shift;
-
- # We need JSON to write the MYMETA.json file
- unless ( eval { require JSON; 1; } ) {
- return 1;
- }
-
- # Generate the data
- my $meta = $self->_write_mymeta_data or return 1;
-
- # Save as the MYMETA.yml file
- print "Writing MYMETA.json\n";
- Module::Install::_write(
- 'MYMETA.json',
- JSON->new->pretty(1)->canonical->encode($meta),
- );
-}
-
-sub _write_mymeta_data {
- my $self = shift;
-
- # If there's no existing META.yml there is nothing we can do
- return undef unless -f 'META.yml';
-
- # We need Parse::CPAN::Meta to load the file
- unless ( eval { require Parse::CPAN::Meta; 1; } ) {
- return undef;
- }
-
- # Merge the perl version into the dependencies
- my $val = $self->Meta->{values};
- my $perl = delete $val->{perl_version};
- if ( $perl ) {
- $val->{requires} ||= [];
- my $requires = $val->{requires};
-
- # Canonize to three-dot version after Perl 5.6
- if ( $perl >= 5.006 ) {
- $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
- }
- unshift @$requires, [ perl => $perl ];
- }
-
- # Load the advisory META.yml file
- my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
- my $meta = $yaml[0];
-
- # Overwrite the non-configure dependency hashs
- delete $meta->{requires};
- delete $meta->{build_requires};
- delete $meta->{recommends};
- if ( exists $val->{requires} ) {
- $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
- }
- if ( exists $val->{build_requires} ) {
- $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
- }
-
- return $meta;
-}
-
-1;
@@ -1,1849 +0,0 @@
-#line 1
-#===============================================================================
-#
-# inc/Module/Install/PRIVATE/Filter/Crypto.pm
-#
-# DESCRIPTION
-# Distribution-specific Module::Install private extension class for
-# Filter-Crypto distribution.
-#
-# COPYRIGHT
-# Copyright (C) 2004-2006, 2008-2010, 2012-2013 Steve Hay. All rights
-# reserved.
-#
-# LICENCE
-# You may distribute under the terms of either the GNU General Public License
-# or the Artistic License, as specified in the LICENCE file.
-#
-#===============================================================================
-
-package Module::Install::PRIVATE::Filter::Crypto;
-
-use 5.006000;
-
-use strict;
-use warnings;
-
-use parent qw(Module::Install::PRIVATE);
-
-use Config qw(%Config);
-use Cwd qw(abs_path);
-use Fcntl;
-use File::Basename qw(dirname);
-use File::Copy qw(copy);
-use File::Spec::Functions qw(canonpath catdir catfile updir);
-use Text::Wrap qw(wrap);
-
-use constant CIPHER_NAME_DES => 'DES';
-use constant CIPHER_NAME_DES_EDE => 'DES_EDE';
-use constant CIPHER_NAME_DES_EDE3 => 'DES_EDE3';
-use constant CIPHER_NAME_RC4 => 'RC4';
-use constant CIPHER_NAME_IDEA => 'IDEA';
-use constant CIPHER_NAME_RC2 => 'RC2';
-use constant CIPHER_NAME_DESX => 'DESX';
-use constant CIPHER_NAME_BLOWFISH => 'Blowfish';
-use constant CIPHER_NAME_NULL => 'Null';
-use constant CIPHER_NAME_RC5 => 'RC5';
-use constant CIPHER_NAME_CAST5 => 'CAST5';
-use constant CIPHER_NAME_AES => 'AES';
-
-use constant CIPHER_MODE_ECB => 'ECB';
-use constant CIPHER_MODE_CBC => 'CBC';
-use constant CIPHER_MODE_CFB => 'CFB';
-use constant CIPHER_MODE_OFB => 'OFB';
-
-use constant CIPHER_KEY_GIVEN_PSWD => 1;
-use constant CIPHER_KEY_RANDOM_PSWD => 2;
-use constant CIPHER_KEY_GIVEN => 3;
-use constant CIPHER_KEY_RANDOM => 4;
-
-use constant RAND_OPTION_STR => 'rand';
-use constant RAND_PSWD_LEN => 32;
-
-use constant RNG_PERL_RAND => 'Perl';
-use constant RNG_CRYPT_RANDOM => 'Crypt::Random';
-use constant RNG_MATH_RANDOM => 'Math::Random';
-use constant RNG_OPENSSL_RAND => 'OpenSSL';
-
-use constant CIPHER_CONFIG_FILENAME => 'CipherConfig.h';
-
-use constant BUILD_OPTION_BOTH => 'both';
-use constant BUILD_OPTION_CRYPTFILE => 'CryptFile';
-use constant BUILD_OPTION_DECRYPT => 'Decrypt';
-
-#===============================================================================
-# CLASS INITIALIZATION
-#===============================================================================
-
-our($VERSION);
-
-BEGIN {
- $VERSION = '1.12';
-
- # Define protected accessor/mutator methods.
- foreach my $prop (qw(
- prefix_dir inc_dir package ver_num ver_str lib_dir lib_name bin_file
- cipher_name cipher_func cipher_needs_iv key_len rc2_key_bits rc5_rounds
- pswd key
- )) {
- no strict 'refs';
- *$prop = sub {
- use strict 'refs';
- my $self = shift;
- $self->{$prop} = shift if @_;
- return $self->{$prop};
- };
- }
-}
-
-#===============================================================================
-# PUBLIC API
-#===============================================================================
-
-# Method to return the instance of this class that it was invoked on, for use in
-# invoking further methods in this class within Makefile.PL. (This method has a
-# suitably unique name to just be autoloaded from Makefile.PL; the other methods
-# do not, so must be invoked on our object to ensure they are dispatched
-# correctly.)
-
-sub get_filter_crypto_private_obj {
- return shift;
-}
-
-# Method to check the Perl being used isn't a "debug" mode build, unless
-# Makefile.PL was invoked with the "--debug-mode" command-line option, in which
-# case it is okay.
-# Only check whether the DEBUGGING symbol is defined in Perl's C compiler flags
-# here. This is sufficient to catch all normal cases. Fuller checks are
-# performed in Decrypt.xs's "BOOT" code (the check is only relevant when the
-# Decrypt component is built).
-
-sub check_perl {
- my $self = shift;
-
- return if exists $self->opts()->{'debug-mode'};
-
- if ($Config{ccflags} =~ /(?:^|\s)-DDEBUGGING(?:\s|$)/) {
- $self->exit_with_error(134,
- 'OS unsupported: The "Decrypt" component requires a "release" ' .
- 'mode build of Perl (i.e. one built without DEBUGGING)'
- );
- }
-}
-
-sub locate_openssl {
- my $self = shift;
-
- print "\n";
-
- $self->query_prefix_dir();
- print "\n";
-
- $self->locate_inc_dir();
- $self->set_inc();
-
- $self->determine_ver_num();
- $self->set_define();
-
- $self->locate_lib_dir_and_file();
- $self->set_libs();
-
- $self->locate_bin_file();
- print "\n";
-}
-
-sub configure_cipher {
- my $self = shift;
-
- my $cipher_config = $self->opts()->{'cipher-config'};
- if (defined $cipher_config) {
- if (-f $cipher_config) {
- $self->show_found_var(
- 'Using specified configuration file', $cipher_config
- );
- $self->copy_cipher_config($cipher_config);
- }
- else {
- $self->exit_with_error(100,
- "No such configuration file '%s'", $cipher_config
- );
- }
- }
- else {
- $self->query_cipher_name();
-
- my $lc_cipher_name = lc $self->cipher_name();
- my $cipher_config_method = "configure_${lc_cipher_name}_cipher";
- $self->$cipher_config_method();
-
- $self->query_pswd_or_key();
-
- $self->write_cipher_config();
- }
-}
-
-sub query_build {
- my $self = shift;
-
- my @build_options = (
- [ BUILD_OPTION_BOTH, 'Build both components' ],
- [ BUILD_OPTION_CRYPTFILE, 'Build CryptFile component only' ],
- [ BUILD_OPTION_DECRYPT, 'Build Decrypt component only' ]
- );
-
- my $build = $self->opts()->{'build'};
- if (defined $build) {
- my %build_options = map { $_->[0] => 1 } @build_options;
- if (exists $build_options{$build}) {
- $self->show_found_var('Using specified build option', $build);
- }
- else {
- $self->exit_with_error(101,
- "Invalid 'build' option value '%s'", $build
- );
- }
- }
- else {
- my $message = 'Build options:';
- my $question = 'Which component(s) do you want to build?';
- my $default = BUILD_OPTION_BOTH;
-
- $build = $self->prompt_list(
- $message, \@build_options, $question, $default
- );
- }
- print "\n";
-
- if ($build eq BUILD_OPTION_BOTH) {
- return [ BUILD_OPTION_CRYPTFILE, BUILD_OPTION_DECRYPT ];
- }
- else {
- return [ $build ];
- }
-}
-
-#===============================================================================
-# PROTECTED API
-#===============================================================================
-
-sub query_prefix_dir {
- my $self = shift;
-
- my $prefix_dir = $self->opts()->{'prefix-dir'};
- if (defined $prefix_dir) {
- $prefix_dir = canonpath(abs_path($prefix_dir));
- if (-d $prefix_dir) {
- $self->show_found_var(
- 'Using specified prefix directory', $prefix_dir
- );
- }
- else {
- $self->exit_with_error(102,
- "No such prefix directory '%s'", $prefix_dir
- );
- }
- }
- else {
- # Look for the main binary executable "openssl" or "ssleay" and use the
- # parent directory of where that is located; otherwise use the default
- # prefix directory as specified in the latest OpenSSL's own INSTALL
- # file if it exists.
- my $bin_file;
- if ($bin_file = $self->can_run('openssl') or
- $bin_file = $self->can_run('ssleay'))
- {
- if ($self->is_win32()) {
- # Find out (if we can) which platform this binary was built for.
- # This information is normally contained in the output of the
- # binary's "version -a" command, labelled "platform: " (or
- # "Platform:" before 0.9.2).
- my $bin_cmd = "$bin_file version -a 2>&1";
-
- my $bin_output = `$bin_cmd`;
- my $bin_rc = $? >> 8;
-
- if ($bin_rc) {
- $self->exit_with_error(133,
- "Could not get OpenSSL/SSLeay version information " .
- "(%d):\n%s", $bin_rc, $bin_output
- );
- }
-
- if ((my $platform) = $bin_output =~ /platform: ?(.*)$/imo) {
- # If we have found a Cygwin binary then we had better not
- # try to use it with our Win32 perl.
- if ($platform =~ /^Cygwin/io) {
- warn("Warning: Ignoring Cygwin OpenSSL/SSLeay binary " .
- "'$bin_file' on Win32\n");
- $bin_file = undef;
- }
- }
- }
- }
-
- my $default;
- if (defined $bin_file) {
- # The binaries are normally located in a sub-directory (bin/,
- # out32/, out32dll/, out32.dbg/, out32dll.dbg or out/) of the prefix
- # directory. See locate_bin_file().
- my $bin_dir = dirname($bin_file);
- $default = canonpath(abs_path(catdir($bin_dir, updir())));
- }
- else {
- $default = $self->is_win32() ? 'C:\\openssl' : '/usr/local/ssl';
- unless (-d $default) {
- if ($self->use_default_response()) {
- $self->exit_with_error(132,
- 'OS unsupported: No prefix directory found for ' .
- 'OpenSSL or SSLeay'
- );
- }
- else {
- $default = '';
- }
- }
- }
-
- my $question = 'Where is your OpenSSL or SSLeay?';
-
- $prefix_dir = $self->prompt_dir($question, $default);
- }
-
- $self->prefix_dir($prefix_dir)
-}
-
-sub locate_inc_dir {
- my $self = shift;
-
- # The headers are normally located in the include/ sub-directory of the
- # prefix directory.
- # Again, build directories on "native" Windows platforms may have the files
- # in a different sub-directory, in this case inc32/ (0.9.0 onwards) or out/
- # (up to and including 0.8.1b), or even outinc/ for MinGW builds. (Beware
- # of version 0.6.0 build directories, which contain an include/ sub-
- # directory containing "Shortcuts" to the real header files in the out/ sub-
- # directory. Check for the presence of the "cyrypto.h" header file to be
- # sure we find the correct sub-directory. The header files are now located
- # in the openssl/ sub-directory of the include directory (0.9.3 onwards),
- # but were located in the include directory itself (up to and including
- # 0.8.1b).)
- my $prefix_dir = $self->prefix_dir();
- my($dir, $inc_dir);
- if (-d ($dir = catdir($prefix_dir, 'include')) and
- (-f catfile($dir, 'openssl', 'crypto.h') or
- -f catfile($dir, 'crypto.h')))
- {
- $inc_dir = $dir;
- }
- elsif ($self->is_win32()) {
- if (-d ($dir = catdir($prefix_dir, 'inc32')) and
- (-f catfile($dir, 'openssl', 'crypto.h') or
- -f catfile($dir, 'crypto.h')))
- {
- $inc_dir = $dir;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'outinc')) and
- (-f catfile($dir, 'openssl', 'crypto.h') or
- -f catfile($dir, 'crypto.h')))
- {
- $inc_dir = $dir;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out')) and
- -f catfile($dir, 'crypto.h'))
- {
- $inc_dir = $dir;
- }
- }
-
- if (defined $inc_dir) {
- $self->show_found_var('Found include directory', $inc_dir);
- $self->inc_dir($inc_dir)
- }
- else {
- $self->exit_with_error(103, 'No include directory found');
- }
-}
-
-sub set_inc {
- my $self = shift;
-
- my $inc_dir = $self->inc_dir();
- $self->inc("-I$inc_dir");
-}
-
-sub determine_ver_num {
- my $self = shift;
-
- # The header files are now located in the openssl/ sub-directory of the
- # include directory (0.9.3 onwards), but were located in the include
- # directory itself (up to and including 0.8.1b).
- my $inc_dir = $self->inc_dir();
- my($dir, $inc_files_dir);
- if (-d ($dir = catdir($inc_dir, 'openssl'))) {
- $inc_files_dir = $dir;
- }
- else {
- $inc_files_dir = $inc_dir;
- }
-
- # The version number is now specified by an OPENSSL_VERSION_NUMBER #define
- # in the opensslv.h header file (0.9.2 onwards). That #define was in the
- # crypto.h header file (0.9.1s), and was called SSLEAY_VERSION_NUMBER (from
- # 0.6.0 to 0.9.0b inclusive). Earlier versions do not seem to have a
- # version number defined in this way, but we do not support anything earlier
- # anyway. The version number is specified as a hexadecimal integer of the
- # form MNNFFPPS (major, minor, fix, patch, status [0 for dev, 1 to 14 for
- # betas, and f for release) (0.9.5a onwards, but with the highest bit set in
- # the patch byte for the 0.9.5s), or of the form MNNFFRBB (major, minor,
- # fix, release, patch or beta) (0.9.3s, 0.9.4s and 0.9.5), or of the form
- # MNFP (major, minor, fix, patch) (up to and including 0.9.2b).
- my($file, $ver_file);
- if (-f ($file = catfile($inc_files_dir, 'opensslv.h'))) {
- $ver_file = $file;
- }
- elsif (-f ($file = catfile($inc_files_dir, 'crypto.h'))) {
- $ver_file = $file;
- }
- else {
- $self->exit_with_error(104, 'No version number header file found');
- }
-
- my $ver_define;
- if (open my $ver_fh, '<', $ver_file) {
- while (<$ver_fh>) {
- if (/^\#define\s+(?:OPENSSL|SSLEAY)_VERSION_NUMBER\s+
- 0x([0-9a-f]+)/iox)
- {
- $ver_define = $1;
- last;
- }
- }
- close $ver_fh;
- }
- else {
- $self->exit_with_error(105,
- "Could not open version number header file '%s' for reading: %s",
- $ver_file, $!
- );
- }
-
- my($major, $minor, $fix, $patch, $status_str);
- if (defined $ver_define) {
- if (length $ver_define == 8 and
- $ver_define =~ /^([0-9a-f])([0-9a-f]{2})([0-9a-f]{2})/io)
- {
- ($major, $minor, $fix) = map { hex } ($1, $2, $3);
-
- my $mmf_ver_num = $major * 10000 + $minor * 100 + $fix;
-
- if ( $mmf_ver_num > 905 or
- ($mmf_ver_num == 905 and $ver_define !~ /100$/o))
- {
- my $status_num;
- ($patch, $status_num) = map { hex }
- $ver_define =~ /([0-9a-f]{2})([0-9a-f])$/io;
-
- $patch = 0xff & ($patch & ~0x80) if $mmf_ver_num == 905;
-
- if ($status_num == 0) {
- $status_str = '-dev';
- }
- elsif ($status_num < 0xf) {
- $status_str = '-beta' . (1 .. 0xe)[$status_num - 1];
- }
- else {
- $status_str = '';
- }
- }
- else {
- my($release, $patch_or_beta) = map { hex }
- $ver_define =~ /([0-9a-f])([0-9a-f]{2})$/io;
-
- if ($release == 0) {
- $patch = 0;
- if ($patch_or_beta == 0) {
- $status_str = '-dev';
- }
- else {
- $status_str = '-beta' . (1 .. 0xff)[$patch_or_beta - 1];
- }
- }
- else {
- $patch = $patch_or_beta;
- $status_str = '';
- }
- }
- }
- elsif (length $ver_define == 4 and
- $ver_define =~ /^([0-9a-f])([0-9a-f])([0-9a-f])([0-9a-f])$/io)
- {
- ($major, $minor, $fix, $patch) = map { hex } ($1, $2, $3, $4);
- $status_str = '';
- }
- else {
- $self->exit_with_error(106,
- 'Unrecognized version number found (%s)', $ver_define
- );
- }
- }
- else {
- $self->exit_with_error(107, 'No version number found');
- }
-
- my $ver_num = $major * 1000000 + $minor * 10000 + $fix * 100 + $patch;
- my $ver_str = "$major.$minor.$fix";
- $ver_str .= ('', 'a' .. 'z')[$patch];
- $ver_str .= $status_str;
-
- my $package = $ver_num >= 90100 ? 'OpenSSL' : 'SSLeay';
- $self->show_found_var("Found $package version", $ver_str);
- $self->package($package);
- $self->ver_str($ver_str);
- $self->ver_num($ver_num);
-}
-
-sub set_define {
- my $self = shift;
-
- my $ver_num = $self->ver_num();
- my $unsafe_mode = exists $self->opts()->{'unsafe-mode'};
- my $debug_mode = exists $self->opts()->{'debug-mode'};
-
- my $define = "-DFILTER_CRYPTO_OPENSSL_VERSION=$ver_num";
- $define .= ' -DFILTER_CRYPTO_UNSAFE_MODE' if $unsafe_mode;
- $define .= ' -DFILTER_CRYPTO_DEBUG_MODE' if $debug_mode;
-
- $self->define($define);
-}
-
-sub locate_lib_dir_and_file {
- my $self = shift;
-
- # The libraries are normally located in the lib/ sub-directory of the prefix
- # directory, but may be in the lib64/ sub-directory on some 64-bit systems,
- # or in the lib/amd64/ or lib/sparcv9/ sub-directory on 64-bit Solaris Intel
- # or 64-bit Solaris Sparc respectively. Some 64-bit systems may have lib/
- # sub-directories as well, so check in lib64/ etc. first, but only check for
- # 64-bit libraries if we are using a 64-bit Perl. Under Debian Multiarch
- # (e.g. Ubuntu >= 11.04) the libraries are migrated to lib/i386-linux-gnu/
- # and lib/x86_64-linux-gnu/ sub-directories.
- # Again, build directories on "native" Windows platforms may have the files
- # in a different sub-directory, in this case out32/, out32dll/, out32.dbg/
- # or out32dll.dbg/ (0.9.0 onwards, depending on whether static or dynamic
- # libraries were built and whether they were built in release or debug mode)
- # or out/ (up to and including 0.8.1b).
- # The Win32 OpenSSL Installation produced by Shining Light Productions
- # installs its libraries into lib/VC (dynamic libraries), lib/VC/static
- # (static libraries) or lib/MinGW.
- my $prefix_dir = $self->prefix_dir();
- my($dir, $lib_dir, $lib_file, $lib_name);
- if ($self->is_win32()) {
- if (-d ($dir = catdir($prefix_dir, 'out32')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out32dll')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out32.dbg')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out32dll.dbg')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif ($Config{cc} =~ /cl/io and
- -d ($dir = catdir($prefix_dir, 'lib', 'VC', 'static')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif ($Config{cc} =~ /cl/io and
- -d ($dir = catdir($prefix_dir, 'lib', 'VC')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif ($Config{cc} =~ /gcc/io and
- -d ($dir = catdir($prefix_dir, 'lib', 'MinGW')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- }
- if (not defined $lib_dir) {
- if (defined $Config{use64bitint} and
- $Config{use64bitint} eq 'define' and
- -d ($dir = catdir($prefix_dir, 'lib64')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (defined $Config{use64bitint} and
- $Config{use64bitint} eq 'define' and
- -d ($dir = catdir($prefix_dir, 'lib', 'amd64')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (defined $Config{use64bitint} and
- $Config{use64bitint} eq 'define' and
- -d ($dir = catdir($prefix_dir, 'lib', 'sparcv9')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (defined $Config{use64bitint} and
- $Config{use64bitint} eq 'define' and
- -d ($dir = catdir($prefix_dir, 'lib', 'x86_64-linux-gnu')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'lib', 'i386-linux-gnu')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'lib')) and
- ($lib_file, $lib_name) = $self->probe_for_lib_file($dir))
- {
- $lib_dir = $dir;
- }
- }
-
- if (defined $lib_dir) {
- $self->show_found_var('Found crypto library', $lib_file);
- $self->lib_dir($lib_dir);
- $self->lib_name($lib_name);
- }
- else {
- $self->exit_with_error(109, 'No crypto library found');
- }
-}
-
-sub probe_for_lib_file {
- my $self = shift;
- my $candidate_lib_dir = shift;
-
- # The libraries on UNIX-type platforms (which includes Cygwin) are called
- # libssl.a (which contains the SSL and TLS implmentations) and libcrypto.a
- # (which contains the ciphers, digests, etc) and are specified as -lssl and
- # -lcrypto respectively. Solaris 10 discourages static linking and Solaris
- # 11 doesn't even ship static libraries for OpenSSL, so libcrypto.so must be
- # used instead where that exists in place of libcrypto.a.
- # On "native" Windows platforms built with the Microsoft Visual C++ (cl) or
- # Borland C++ (bcc32) they are called ssleay32.lib and libeay32.lib and are
- # specified as -lssleay32 and -llibeay32 (0.8.0 onwards), or ssl32.lib and
- # crypt32.lib, specified as -lssl32 and -lcrypt32 (0.6.0 to 0.6.6b
- # inclusive), or ssl.lib and crypto.lib, specified as -lssl and -lcrypto
- # (0.5.2 and 0.5.2a).
- # It is also possible to produce "native" Windows builds using GCC (i.e.
- # binaries and libraries that are linked against the Microsoft C run-time
- # library msvcrt.dll rather than Cygwin's POSIX C run-time library
- # cygwin1.dll) via MinGW (gcc). In that case, the OpenSSL libraries are
- # called either libssl.a and libcrypto.a (for static builds) or libssl32.a
- # and libeay32.a [sic] (for dynamic builds). They are specified as on UNIX-
- # type platforms, as described in the ExtUtils::Liblist manpage.
- # The Win32 OpenSSL Installation produced by Shining Light Productions names
- # its libraries differently. The Visual C++ libraries are named as normal
- # but with a MD, MDd, MT or MTd suffix just before the .lib extension (e.g.
- # libeay32MD.lib), depending on whether they were built with the -MD or -MT
- # compiler option (of which only the former is supported by perl) and
- # whether they were built in release or debug mode. The MinGW libraries are
- # only provided as dynamic release build libraries, and are named similarly
- # to the default names of VC++ libraries, namely ssleay32.a and libeay32.a.
- my($file, $lib_file, $lib_name);
- if ($self->is_win32()) {
- if ($Config{cc} =~ /gcc/io) {
- if (-f ($file = catfile($candidate_lib_dir, 'libcrypto.a'))) {
- $lib_file = $file;
- $lib_name = 'crypto';
- }
- elsif (-f ($file = catfile($candidate_lib_dir, 'libeay32.a'))) {
- $lib_file = $file;
- $lib_name = 'eay32';
- }
- }
- else {
- if (-f ($file = catfile($candidate_lib_dir, 'libeay32.lib'))) {
- $lib_file = $file;
- $lib_name = 'libeay32';
- }
- elsif (-f ($file = catfile($candidate_lib_dir, 'crypt32.lib'))) {
- $lib_file = $file;
- $lib_name = 'crypt32';
- }
- elsif (-f ($file = catfile($candidate_lib_dir, 'crypto.lib'))) {
- $lib_file = $file;
- $lib_name = 'crypto';
- }
- elsif ($Config{cc} =~ /cl/io and
- -f ($file = catfile($candidate_lib_dir, 'libeay32MD.lib')))
- {
- $lib_file = $file;
- $lib_name = 'libeay32MD';
- }
- elsif ($Config{cc} =~ /cl/io and
- -f ($file = catfile($candidate_lib_dir, 'libeay32MDd.lib')))
- {
- $lib_file = $file;
- $lib_name = 'libeay32MDd';
- }
- }
- }
- else {
- if (-f ($file = catfile($candidate_lib_dir, 'libcrypto.a'))) {
- $lib_file = $file;
- $lib_name = 'crypto';
- }
- elsif (-f ($file = catfile($candidate_lib_dir, 'libcrypto.so'))) {
- $lib_file = $file;
- $lib_name = 'crypto';
- }
- elsif (-f ($file = catfile($candidate_lib_dir, 'libcrypto.dylib'))) {
- $lib_file = $file;
- $lib_name = 'crypto';
- }
- }
-
- return $lib_file ? ($lib_file, $lib_name) : ();
-}
-
-sub set_libs {
- my $self = shift;
-
- my $lib_dir = $self->lib_dir();
- my $lib_name = $self->lib_name();
- $self->libs("-L$lib_dir -l$lib_name");
-}
-
-sub locate_bin_file {
- my $self = shift;
-
- # The binaries are normally located in the bin/ sub-directory of the prefix
- # directory.
- # However, we may be working with a build directory rather than an
- # installation directory, in which case the binary files will be in a
- # different sub-directory on "native" Windows platforms, in this case
- # out32/, out32dll/, out32.dbg/ or out32dll.dbg/ (0.9.0 onwards, depending
- # on whether static or dynamic libraries were built and whether they were
- # built in release or debug mode) or out/ (up to and including 0.8.1b).
- my $prefix_dir = $self->prefix_dir();
- my($dir, $bin_file);
- my $found = 0;
- if (-d ($dir = catdir($prefix_dir, 'bin')) and
- defined($bin_file = $self->probe_for_bin_file($dir)))
- {
- $found = 1;
- }
- elsif ($self->is_win32()) {
- if (-d ($dir = catdir($prefix_dir, 'out32')) and
- defined($bin_file = $self->probe_for_bin_file($dir)))
- {
- $found = 1;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out32dll')) and
- defined($bin_file = $self->probe_for_bin_file($dir)))
- {
- $found = 1;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out32.dbg')) and
- defined($bin_file = $self->probe_for_bin_file($dir)))
- {
- $found = 1;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out32dll.dbg')) and
- defined($bin_file = $self->probe_for_bin_file($dir)))
- {
- $found = 1;
- }
- elsif (-d ($dir = catdir($prefix_dir, 'out')) and
- defined($bin_file = $self->probe_for_bin_file($dir)))
- {
- $found = 1;
- }
- }
-
- if ($found) {
- $self->show_found_var('Found binary executable', $bin_file);
- $self->bin_file($bin_file)
- }
- else {
- $self->exit_with_error(111, 'No binary executable found');
- }
-}
-
-sub probe_for_bin_file {
- my $self = shift;
- my $candidate_bin_dir = shift;
-
- # The main binary executable is called "openssl" from 0.9.3 onwards, but
- # used to be called "ssleay" up to and including 0.9.2b.
- my($file, $bin_file);
- if (-f ($file = catfile($candidate_bin_dir, "openssl$Config{_exe}"))) {
- $bin_file = $file;
- }
- elsif (-f ($file = catfile($candidate_bin_dir, "ssleay$Config{_exe}"))) {
- $bin_file = $file;
- }
-
- return $bin_file;
-}
-
-sub query_cipher_name {
- my $self = shift;
-
- my $ver_num = $self->ver_num();
-
- # Find out (as best as we can) which ciphers, if any, have been disabled in
- # the particular crypto library that we are using. Ciphers can be disabled
- # at build time via "-DOPENSSL_NO_<cipher_name>" (or "-DNO_<cipher_name>"
- # before 0.9.7), where <cipher_name> can be one of: "DES", "RC4", "IDEA",
- # "RC2", "BF" (or "BLOWFISH" before 0.9.3), "RC5", "CAST" or "AES". This
- # information is normally contained in the output of the main binary
- # executable's "version -a" command, labelled "compiler: " (or "C flags:"
- # before 0.9.2) and not always on a line of its own.
- my $bin_file = $self->bin_file();
- my $bin_cmd = "$bin_file version -a 2>&1";
-
- my $bin_output = `$bin_cmd`;
- my $bin_rc = $? >> 8;
-
- if ($bin_rc) {
- $self->exit_with_error(112,
- "Could not get %s version information (%d):\n%s",
- $self->package(), $bin_rc, $bin_output
- );
- }
-
- my %disabled = ();
- if ((my $compiler) = $bin_output =~ /(?:C flags|compiler): ?(.*)$/imo) {
- %disabled = map { $_ => 1 }
- $compiler =~ m|[-/]D ?"?(?:OPENSSL_)?NO_(\w+)"?|go;
- }
-
- my @cipher_names = ();
-
- # The DES, DES-EDE, DES-EDE3, RC4 and IDEA ciphers have been in the crypto
- # library since the earliest version that had the EVP_*() functions
- # (SSLeay 0.5.1).
- if (not exists $disabled{DES}) {
- push @cipher_names, (
- [ CIPHER_NAME_DES, 'DES block cipher' ],
- [ CIPHER_NAME_DES_EDE, 'Two key triple DES block cipher' ],
- [ CIPHER_NAME_DES_EDE3, 'Three key triple DES block cipher' ]
- );
- }
-
- if (not exists $disabled{RC4}) {
- push @cipher_names, (
- [ CIPHER_NAME_RC4, 'RC4 stream cipher' ]
- );
- }
-
- if (not exists $disabled{IDEA}) {
- push @cipher_names, (
- [ CIPHER_NAME_IDEA, 'IDEA block cipher' ]
- );
- }
-
- # The RC2 cipher was added in SSLeay 0.5.2.
- if (not exists $disabled{RC2} and $ver_num >= 50200) {
- push @cipher_names, (
- [ CIPHER_NAME_RC2, 'RC2 block cipher' ]
- );
- }
-
- # The DESX cipher was added in SSLeay 0.6.2.
- if (not exists $disabled{DES} and $ver_num >= 60200) {
- push @cipher_names, (
- [ CIPHER_NAME_DESX, 'DESX block cipher' ]
- );
- }
-
- # The Blowfish cipher was added in SSLeay 0.6.6.
- if (not exists $disabled{BLOWFISH} and not exists $disabled{BF} and
- $ver_num >= 60600)
- {
- push @cipher_names, (
- [ CIPHER_NAME_BLOWFISH, 'Blowfish block cipher' ]
- );
- }
-
- # The null cipher was added in SSLeay 0.8.0.
- if ($ver_num >= 80000) {
- push @cipher_names, (
- [ CIPHER_NAME_NULL, 'Null cipher' ]
- );
- }
-
- # The RC5 and CAST5 ciphers were added in SSLeay 0.9.0.
- if (not exists $disabled{RC5} and $ver_num >= 90000) {
- push @cipher_names, (
- [ CIPHER_NAME_RC5, 'RC5 block cipher' ]
- );
- }
-
- if (not exists $disabled{CAST} and $ver_num >= 90000) {
- push @cipher_names, (
- [ CIPHER_NAME_CAST5, 'CAST5 block cipher' ]
- );
- }
-
- # The AES cipher was added in OpenSSL 0.9.7.
- if (not exists $disabled{AES} and $ver_num >= 90700) {
- push @cipher_names, (
- [ CIPHER_NAME_AES, 'AES block cipher' ]
- );
- }
-
- my $cipher_name = $self->opts()->{'cipher-name'};
- if (defined $cipher_name) {
- my %lc_cipher_names = map { lc $_->[0] => 1 } @cipher_names;
- if (exists $lc_cipher_names{lc $cipher_name}) {
- $self->show_found_var('Using specified cipher name', $cipher_name);
- }
- else {
- $self->exit_with_error(113,
- "No such cipher name '%s'", $cipher_name
- );
- }
- }
- else {
- my $message = 'Cipher algorithms available:';
- my $question = 'Which cipher algorithm do you want to use?';
-
- my $default;
- if (not exists $disabled{DES} and $ver_num < 90700) {
- $default = CIPHER_NAME_DES_EDE3;
- }
- elsif (not exists $disabled{AES} and $ver_num >= 90700) {
- $default = CIPHER_NAME_AES;
- }
- else {
- $default = $cipher_names[$#cipher_names][0];
- }
-
- $cipher_name = $self->prompt_list(
- $message, \@cipher_names, $question, $default
- );
- }
- print "\n";
-
- $self->cipher_name($cipher_name);
-}
-
-sub query_cipher_mode {
- my $self = shift;
-
- my @cipher_modes = (
- [ CIPHER_MODE_ECB, 'ECB (Electronic Codebook Mode)' ],
- [ CIPHER_MODE_CBC, 'CBC (Cipher Block Chaining Mode)' ],
- [ CIPHER_MODE_CFB, 'CFB (64-Bit Cipher Feedback Mode)' ],
- [ CIPHER_MODE_OFB, 'OFB (64-Bit Output Feedback Mode)' ]
- );
-
- my $cipher_mode = $self->opts()->{'cipher-mode'};
- if (defined $cipher_mode) {
- my %lc_cipher_modes = map { lc $_->[0] => $_->[0] } @cipher_modes;
- if (exists $lc_cipher_modes{lc $cipher_mode}) {
- $self->show_found_var('Using specified cipher mode', $cipher_mode);
- $cipher_mode = $lc_cipher_modes{lc $cipher_mode};
- }
- else {
- $self->exit_with_error(114,
- "No such cipher mode '%s'", $cipher_mode
- );
- }
- }
- else {
- my $message = 'Modes of operation available:';
- my $question = 'Which mode of operation do you want to use?';
- my $default = CIPHER_MODE_CBC;
-
- $cipher_mode = $self->prompt_list(
- $message, \@cipher_modes, $question, $default
- );
- }
- print "\n";
-
- return $cipher_mode;
-}
-
-sub query_key_len {
- my $self = shift;
- my %args = @_;
-
- my $ver_num = $self->ver_num();
-
- my $validate;
- if (exists $args{-fixed}) {
- $validate = sub { $_[0] eq $args{-fixed} };
- }
- elsif ($ver_num < 90600) {
- # Before 0.9.6 there was no facility in the EVP library API for setting
- # the key length for variable key lengths ciphers so we can only use the
- # default value. This should have been specified in the %args, but we
- # provide a default default value of 16 just in case.
- $args{-default} = 16 unless exists $args{-default};
- $validate = sub { $_[0] eq $args{-default} };
- }
- elsif (exists $args{-valid}) {
- my %valid = map { $_ => 1 } @{$args{-valid}};
- $validate = sub { exists $valid{$_[0]} };
- }
- else {
- my $int_pat = qr/^(?:0|[1-9](?:\d+)?)$/o;
- # Minimum key size is clearly 0 bytes if it is not otherwise set
- # already. Restrict the maximum key size to some sensible value if it
- # is not set already: we do not want to allow the user to enter an
- # arbitrarily large integer.
- $args{-min} = 0 unless exists $args{-min};
- $args{-max} = 1024 unless exists $args{-max};
- $validate = sub {
- $_[0] =~ $int_pat and $_[0] >= $args{-min} and $_[0] <= $args{-max}
- };
- }
-
- my $key_len = $self->opts()->{'key-len'};
- my $key = $self->opts()->{key};
- if (defined $key_len) {
- if ($validate->($key_len)) {
- $self->show_found_var('Using specified key length', $key_len);
- }
- else {
- $self->exit_with_error(115, "Invalid key length '%d'", $key_len);
- }
- }
- elsif (defined $key and $key ne RAND_OPTION_STR) {
- $key_len = length($key) / 2;
- if ($validate->($key_len)) {
- $self->show_found_var('Using inferred key length', $key_len);
- }
- else {
- $self->exit_with_error(116, "Invalid length key (%d)", $key_len);
- }
- }
- elsif (exists $args{-fixed}) {
- $key_len = $args{-fixed};
- $self->show_found_var('Using fixed key length', $key_len);
- }
- elsif ($ver_num < 90600) {
- $key_len = $args{-default};
- $self->show_found_var('Using default key length', $key_len);
- }
- else {
- my $message = "This is a variable key length algorithm.\n";
-
- if (exists $args{-valid}) {
- my @key_lens = @{$args{-valid}};
- my $max_key_len = pop @key_lens;
- $message .= sprintf 'Valid key lengths are: %s or %d bytes.',
- join(', ', @key_lens), $max_key_len;
- }
- else {
- $message .= sprintf 'Valid key lengths are from %d byte%s up to ' .
- '%d byte%s.',
- $args{-min}, $args{-min} == 1 ? '' : 's',
- $args{-max}, $args{-max} == 1 ? '' : 's';
- }
-
- my $question = 'What key length (in bytes) do you want to use?';
-
- $key_len = $self->prompt_validate(
- -message => $message,
- -question => $question,
- -default => $args{-default},
- -validate => $validate
- );
- }
- print "\n";
-
- $self->key_len($key_len);
-}
-
-sub query_rc2_key_bits {
- my $self = shift;
-
- # The "effective key bits" parameter can be from 1 to 1024 bits: see RFC
- # 2268.
- my %args = (-min => 1, -max => 1024, -default => 128);
-
- my $ver_num = $self->ver_num();
-
- my $validate;
- if ($ver_num < 90600) {
- # Before 0.9.6 there was no facility in the EVP library API for setting
- # the effective key bits for the RC2 cipher so we can only use the
- # default value.
- $validate = sub { $_[0] eq $args{-default} };
- }
- else {
- my $int_pat = qr/^(?:0|[1-9](?:\d+)?)$/o;
- $validate = sub {
- $_[0] =~ $int_pat and $_[0] >= $args{-min} and $_[0] <= $args{-max}
- };
- }
-
- my $rc2_key_bits = $self->opts()->{'rc2-key-bits'};
- if (defined $rc2_key_bits) {
- if ($validate->($rc2_key_bits)) {
- $self->show_found_var(
- 'Using specified RC2 key bits', $rc2_key_bits
- );
- }
- else {
- $self->exit_with_error(117,
- "Invalid RC2 key bits '%d'", $rc2_key_bits
- );
- }
- }
- elsif ($ver_num < 90600) {
- $rc2_key_bits = $args{-default};
- $self->show_found_var('Using default RC2 key bits', $rc2_key_bits);
- }
- else {
- my $message = "This algorithm also has an 'effective key bits' (EKB) " .
- "parameter.\n";
-
- $message .= sprintf 'Valid EKB values are from %d bit%s up to %d ' .
- 'bit%s.',
- $args{-min}, $args{-min} == 1 ? '' : 's',
- $args{-max}, $args{-max} == 1 ? '' : 's';
-
- my $question = 'What EKB value (in bits) do you want to use?';
-
- $rc2_key_bits = $self->prompt_validate(
- -message => $message,
- -question => $question,
- -default => $args{-default},
- -validate => $validate
- );
- }
- print "\n";
-
- $self->rc2_key_bits($rc2_key_bits);
-}
-
-sub query_rc5_rounds {
- my $self = shift;
-
- # The "number of rounds" parameter can be from 0 to 255: see RFC 2040.
- # However, it can currently only be set to 8, 12 or 16 by the RC5 code in
- # OpenSSL: see EVP_EncryptInit.pod in recent OpenSSL distributions.
- my %args = (-valid => [8, 12, 16], -default => 12);
-
- my $ver_num = $self->ver_num();
-
- my $validate;
- if ($ver_num < 90600) {
- # Before 0.9.6 there was no facility in the EVP library API for setting
- # the number of rounds for the RC5 cipher so we can only use the default
- # value.
- $validate = sub { $_[0] eq $args{-default} };
- }
- else {
- my %valid = map { $_ => 1 } @{$args{-valid}};
- $validate = sub { exists $valid{$_[0]} };
- }
-
- my $rc5_rounds = $self->opts()->{'rc5-rounds'};
- if (defined $rc5_rounds) {
- if ($validate->($rc5_rounds)) {
- $self->show_found_var('Using specified RC5 rounds', $rc5_rounds);
- }
- else {
- $self->exit_with_error(118,
- "Invalid RC5 rounds '%d'", $rc5_rounds
- );
- }
- }
- elsif ($ver_num < 90600) {
- $rc5_rounds = $args{-default};
- $self->show_found_var('Using default RC5 rounds', $rc5_rounds);
- }
- else {
- my $message = "This algorithm also has a 'number of rounds' " .
- "parameter.\n";
-
- my @rc5_rounds = @{$args{-valid}};
- my $max_rc5_rounds = pop @rc5_rounds;
- $message .= sprintf 'Valid numbers of rounds are: %s or %d.',
- join(', ', @rc5_rounds), $max_rc5_rounds;
-
- my $question = 'What number of rounds do you want to use?';
-
- $rc5_rounds = $self->prompt_validate(
- -message => $message,
- -question => $question,
- -default => $args{-default},
- -validate => $validate
- );
- }
- print "\n";
-
- $self->rc5_rounds($rc5_rounds);
-}
-
-sub query_pswd_or_key {
- my $self = shift;
-
- my $key_len = $self->key_len();
-
- if ($key_len == 0) {
- $self->key('');
- return;
- }
-
- my $validate_pswd = sub {
- $_[0] ne ''
- };
-
- my $validate_key = sub {
- $_[0] =~ /^[0-9a-f]*$/io and length $_[0] == 2 * $key_len
- };
-
- my $pswd = $self->opts()->{pswd};
- my $key = $self->opts()->{key};
- if (defined $pswd) {
- if (lc $pswd eq lc RAND_OPTION_STR) {
- $pswd = $self->generate_rand_pswd();
- print "\n";
-
- $self->show_found_var('Using randomly generated password', $pswd);
- $self->pswd($pswd);
- }
- elsif ($validate_pswd->($pswd)) {
- $self->show_found_var('Using specified password', $pswd);
- $self->pswd(unpack 'H*', $pswd);
- }
- else {
- $self->exit_with_error(119, "Invalid password '%s'", $pswd);
- }
- }
- elsif (defined $key) {
- if (lc $key eq lc RAND_OPTION_STR) {
- $key = $self->generate_rand_key();
- print "\n";
-
- $self->show_found_var('Using randomly generated key', $key);
- $self->key($key);
- }
- elsif ($validate_key->($key)) {
- $self->show_found_var('Using specified key', $key);
- $self->key($key);
- }
- else {
- $self->exit_with_error(120, "Invalid key '%s'", $key);
- }
- }
- else {
- my @cipher_key_sources = (
- [ CIPHER_KEY_GIVEN_PSWD, 'Enter a password when prompted' ],
- [ CIPHER_KEY_RANDOM_PSWD, 'Have a password randomly generated' ],
- [ CIPHER_KEY_GIVEN, 'Enter a key when prompted' ],
- [ CIPHER_KEY_RANDOM, 'Have a key randomly generated' ]
- );
-
- my $message = 'You can either specify a password from which the ' .
- 'key to be used for encryption/decryption will be ' .
- 'derived using a PKCS#5 key derivation algorithm, or ' .
- "you can directly specify the key to use.\n" .
- 'You can also have a password or key randomly ' .
- "generated for you.\n\n" .
- 'Options for specifying or deriving the key:';
- my $question = 'How do you want to specify or derive the key?';
- my $default = CIPHER_KEY_RANDOM_PSWD;
-
- my $cipher_key_source = $self->prompt_list(
- $message, \@cipher_key_sources, $question, $default
- );
-
- print "\n";
-
- if ($cipher_key_source == CIPHER_KEY_GIVEN_PSWD) {
- $message = 'Enter your password:';
- $question = 'Password?';
- $default = '';
-
- $pswd = $self->prompt_validate(
- -message => $message,
- -question => $question,
- -default => $default,
- -validate => $validate_pswd
- );
-
- $self->pswd(unpack 'H*', $pswd);
- }
- elsif ($cipher_key_source == CIPHER_KEY_RANDOM_PSWD) {
- $pswd = $self->generate_rand_pswd();
- $self->pswd($pswd);
- }
- elsif ($cipher_key_source == CIPHER_KEY_GIVEN) {
- $message = "Enter your ${key_len}-byte key with each byte " .
- "written as a pair of hexadecimal digits with the " .
- "high nybble first:";
- $question = 'Key?';
- $default = '';
-
- $key = $self->prompt_validate(
- -message => $message,
- -question => $question,
- -default => $default,
- -validate => $validate_key
- );
-
- $self->key($key);
- }
- elsif ($cipher_key_source == CIPHER_KEY_RANDOM) {
- $key = $self->generate_rand_key();
- $self->key($key);
- }
- else {
- $self->exit_with_error(121,
- "Unknown key source '%s'", $cipher_key_source
- );
- }
- }
-
- print "\n";
-}
-
-sub generate_rand_key {
- my $self = shift;
- return $self->generate_rand_octets_hex($self->key_len());
-}
-
-sub generate_rand_pswd {
- my $self = shift;
- return $self->generate_rand_octets_hex(RAND_PSWD_LEN);
-}
-
-sub generate_rand_octets_hex {
- my $self = shift;
- my $num_octets = shift;
-
- my $rng = $self->query_rng();
-
- my $octets;
- if (lc $rng eq lc RNG_PERL_RAND) {
- $octets = '';
- for (1 .. $num_octets) {
- $octets .= chr int rand 256;
- }
- }
- elsif (lc $rng eq lc RNG_CRYPT_RANDOM) {
- # Delay the loading of Crypt::Random until it is actually required since
- # it is not a standard module.
- my $ok = eval {
- require Crypt::Random;
- Crypt::Random->import(qw(makerandom_octet));
- 1;
- };
-
- if (not $ok) {
- $self->exit_with_error(122,
- "Can't load Crypt::Random module for random number generation"
- );
- }
-
- # Specify "Strength => 0" to use /dev/urandom rather than /dev/random
- # to avoid potentially blocking for a long time.
- $octets = makerandom_octet(
- Length => $num_octets, Strength => 0
- );
- }
- elsif (lc $rng eq lc RNG_MATH_RANDOM) {
- # Delay the loading of Math::Random until it is actually required since
- # it is not a standard module.
- my $ok = eval {
- require Math::Random;
- Math::Random->import(qw(random_uniform_integer));
- 1;
- };
-
- if (not $ok) {
- $self->exit_with_error(123,
- "Can't load Math::Random module for random number generation"
- );
- }
-
- $octets = join '',
- map { chr } random_uniform_integer($num_octets, 0, 255);
- }
- elsif (lc $rng eq lc RNG_OPENSSL_RAND) {
- my $bin_file = $self->bin_file();
- my $out_filename = 'rand.out';
-
- my $bin_cmd = "$bin_file rand -out $out_filename $num_octets 2>&1";
-
- my $bin_output = `$bin_cmd`;
- my $bin_rc = $? >> 8;
-
- if ($bin_rc) {
- $self->exit_with_error(124,
- "Could not generate %d random bytes (%d):\n%s",
- $num_octets, $bin_rc, $bin_output
- );
- }
-
- sysopen my $out_fh, $out_filename, O_RDONLY | O_BINARY or
- $self->exit_with_error(125,
- "Could not open random bytes output file '%s' for reading: %s",
- $out_filename, $!
- );
-
- my $num_octets_read = sysread $out_fh, $octets, $num_octets;
- if (not defined $num_octets_read) {
- $self->exit_with_error(126,
- "Could not read random bytes from output file '%s': %s",
- $out_filename, $!
- );
- }
- elsif ($num_octets_read != $num_octets) {
- $self->exit_with_error(127,
- "Could not read random bytes from output file '%s': %d bytes " .
- "read, %d bytes expected",
- $out_filename, $num_octets_read, $num_octets
- );
- }
-
- close $out_fh;
- unlink $out_filename;
- }
- else {
- $self->exit_with_error(128,
- "Unknown random number generator '%s'", $rng
- );
- }
-
- return unpack 'H*', $octets;
-}
-
-sub query_rng {
- my $self = shift;
-
- my $ver_num = $self->ver_num();
- my $package = $self->package();
-
- my @rngs = (
- [ RNG_PERL_RAND, "Perl's built-in rand() function" ]
- );
-
- if (eval { require Crypt::Random; 1 }) {
- push @rngs, (
- [ RNG_CRYPT_RANDOM, 'Crypt::Random' ]
- );
- }
-
- if (eval { require Math::Random; 1 }) {
- push @rngs, (
- [ RNG_MATH_RANDOM, 'Math::Random' ]
- );
- }
-
- # The "rand" command was added in OpenSSL 0.9.5a.
- if ($ver_num >= 90501) {
- push @rngs, (
- [ RNG_OPENSSL_RAND, "${package}'s rand command" ]
- );
- }
-
- my $rng = $self->opts()->{rng};
- if (defined $rng) {
- my %lc_rngs = map { lc $_->[0] => $_->[0] } @rngs;
- if (exists $lc_rngs{lc $rng}) {
- $self->show_found_var('Using specified RNG', $rng);
- $rng = $lc_rngs{lc $rng};
- }
- else {
- $self->exit_with_error(129,
- "Invalid random number generator '%s'", $rng
- );
- }
- }
- else {
- my $message = 'Random number generators:';
- my $question = 'Which RNG do you want to use?';
- my $default = $rngs[$#rngs][0];
-
- $rng = $self->prompt_list(
- $message, \@rngs, $question, $default
- );
- }
-
- return $rng;
-}
-
-sub configure_des_cipher {
- my $self = shift;
-
- my %cipher_funcs = (
- CIPHER_MODE_ECB, 'EVP_des_ecb()',
- CIPHER_MODE_CBC, 'EVP_des_cbc()',
- CIPHER_MODE_CFB, 'EVP_des_cfb()',
- CIPHER_MODE_OFB, 'EVP_des_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- $self->cipher_func($cipher_funcs{$cipher_mode});
- $self->cipher_needs_iv(1);
-
- # The DES cipher can only use an 8 byte key (of which only 7 bytes are
- # actually used by the algorithm): see FIPS PUB 46-3.
- $self->query_key_len(-fixed => 8);
-}
-
-sub configure_des_ede_cipher {
- my $self = shift;
-
- my $ver_num = $self->ver_num();
- my %cipher_funcs = (
- CIPHER_MODE_ECB, ($ver_num < 90700
- ? 'EVP_des_ede()' : 'EVP_des_ede_ecb()'),
- CIPHER_MODE_CBC, 'EVP_des_ede_cbc()',
- CIPHER_MODE_CFB, 'EVP_des_ede_cfb()',
- CIPHER_MODE_OFB, 'EVP_des_ede_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- $self->cipher_func($cipher_funcs{$cipher_mode});
- $self->cipher_needs_iv(1);
-
- # The DES-EDE cipher is two-key triple-DES (i.e. in which an encrypt
- # operation is encrypt with key 1, decrypt with key 2, encrypt with key 1),
- # and therefore requires a key length equivalent to two DES keys, i.e. 16
- # bytes (of which only 14 are used).
- $self->query_key_len(-fixed => 16);
-}
-
-sub configure_des_ede3_cipher {
- my $self = shift;
-
- my $ver_num = $self->ver_num();
- my %cipher_funcs = (
- CIPHER_MODE_ECB, ($ver_num < 90700
- ? 'EVP_des_ede3()' : 'EVP_des_ede3_ecb()'),
- CIPHER_MODE_CBC, 'EVP_des_ede3_cbc()',
- CIPHER_MODE_CFB, 'EVP_des_ede3_cfb()',
- CIPHER_MODE_OFB, 'EVP_des_ede3_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- $self->cipher_func($cipher_funcs{$cipher_mode});
- $self->cipher_needs_iv(1);
-
- # The DES-EDE3 cipher is three-key triple-DES (i.e. in which an encrypt
- # operation is encrypt with key 1, decrypt with key 2, encrypt with key 3),
- # and therefore requires a key length equivalent to two DES keys, i.e. 24
- # bytes (of which only 21 are used).
- $self->query_key_len(-fixed => 24);
-}
-
-sub configure_rc4_cipher {
- my $self = shift;
-
- $self->cipher_func('EVP_rc4()');
- $self->cipher_needs_iv(0);
-
- # The RC4 cipher can use any key length: see rc4.doc in old SSLeay
- # distributions.
- $self->query_key_len(-min => 1, -default => 16);
-}
-
-sub configure_idea_cipher {
- my $self = shift;
-
- my %cipher_funcs = (
- CIPHER_MODE_ECB, 'EVP_idea_ecb()',
- CIPHER_MODE_CBC, 'EVP_idea_cbc()',
- CIPHER_MODE_CFB, 'EVP_idea_cfb()',
- CIPHER_MODE_OFB, 'EVP_idea_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- $self->cipher_func($cipher_funcs{$cipher_mode});
- $self->cipher_needs_iv(1);
-
- # The IDEA cipher can only use a 16 byte key: see idea.doc in old SSLeay
- # distributions.
- $self->query_key_len(-fixed => 16);
-}
-
-sub configure_rc2_cipher {
- my $self = shift;
-
- my %cipher_funcs = (
- CIPHER_MODE_ECB, 'EVP_rc2_ecb()',
- CIPHER_MODE_CBC, 'EVP_rc2_cbc()',
- CIPHER_MODE_CFB, 'EVP_rc2_cfb()',
- CIPHER_MODE_OFB, 'EVP_rc2_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- $self->cipher_func($cipher_funcs{$cipher_mode});
- $self->cipher_needs_iv(1);
-
- # The RC2 cipher can use any key length from 1 to 128 bytes: see RFC 2268.
- $self->query_key_len(-min => 1, -max => 128, -default => 16);
-
- # The RC2 cipher also has a parameter called "effective key bits".
- $self->query_rc2_key_bits();
-}
-
-sub configure_desx_cipher {
- my $self = shift;
-
- $self->cipher_func('EVP_desx_cbc()');
- $self->cipher_needs_iv(1);
-
- # The DESX cipher can only use a 24 byte key: see des.pod in recent OpenSSL
- # distributions.
- $self->query_key_len(-fixed => 24);
-}
-
-sub configure_blowfish_cipher {
- my $self = shift;
-
- my %cipher_funcs = (
- CIPHER_MODE_ECB, 'EVP_bf_ecb()',
- CIPHER_MODE_CBC, 'EVP_bf_cbc()',
- CIPHER_MODE_CFB, 'EVP_bf_cfb()',
- CIPHER_MODE_OFB, 'EVP_bf_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- $self->cipher_func($cipher_funcs{$cipher_mode});
- $self->cipher_needs_iv(1);
-
- # The Blowfish cipher can use any key length up to 72 bytes: see
- # blowfish.doc in old SSLeay distributions.
- $self->query_key_len(-min => 1, -max => 72, -default => 16);
-}
-
-sub configure_null_cipher {
- my $self = shift;
-
- $self->cipher_func('EVP_enc_null()');
- $self->cipher_needs_iv(0);
-
- # The null cipher does not require a key: it does nothing.
- $self->query_key_len(-fixed => 0);
-}
-
-sub configure_rc5_cipher {
- my $self = shift;
-
- my %cipher_funcs = (
- CIPHER_MODE_ECB, 'EVP_rc5_32_12_16_ecb()',
- CIPHER_MODE_CBC, 'EVP_rc5_32_12_16_cbc()',
- CIPHER_MODE_CFB, 'EVP_rc5_32_12_16_cfb()',
- CIPHER_MODE_OFB, 'EVP_rc5_32_12_16_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- $self->cipher_func($cipher_funcs{$cipher_mode});
- $self->cipher_needs_iv(1);
-
- # The RC5 cipher can use any key length from 0 to 255 bytes: see RFC 2040.
- $self->query_key_len(-min => 0, -max => 255, -default => 16);
-
- # The RC5 cipher also has a parameter called "number of rounds".
- $self->query_rc5_rounds();
-}
-
-sub configure_cast5_cipher {
- my $self = shift;
-
- my %cipher_funcs = (
- CIPHER_MODE_ECB, 'EVP_cast5_ecb()',
- CIPHER_MODE_CBC, 'EVP_cast5_cbc()',
- CIPHER_MODE_CFB, 'EVP_cast5_cfb()',
- CIPHER_MODE_OFB, 'EVP_cast5_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- $self->cipher_func($cipher_funcs{$cipher_mode});
- $self->cipher_needs_iv(1);
-
- # The CAST5 cipher can use any key length from 5 to 16 bytes: see RFC 2144.
- $self->query_key_len(-min => 5, -max => 16, -default => 16);
-}
-
-sub configure_aes_cipher {
- my $self = shift;
-
- my %cipher_funcs = (
- CIPHER_MODE_ECB, 'EVP_aes_ecb()',
- CIPHER_MODE_CBC, 'EVP_aes_cbc()',
- CIPHER_MODE_CFB, 'EVP_aes_cfb()',
- CIPHER_MODE_OFB, 'EVP_aes_ofb()'
- );
- my $cipher_mode = $self->query_cipher_mode();
- my $cipher_func = $cipher_funcs{$cipher_mode};
-
- # The AES cipher can only use a 16, 24 or 32 byte key: see FIPS PUB 197. Do
- # not offer the choice of 24 or 32 byte keys for 0.9.7 because they do not
- # seem to work. I do not know why, and the problem does not seem to occur
- # with debug OpenSSL builds, which does not make it very easy to find out
- # why.
- my $ver_num = $self->ver_num();
- if ($ver_num == 90700) {
- $self->query_key_len(-fixed => 16);
- }
- else {
- $self->query_key_len(-valid => [16, 24, 32], -default => 32);
- }
-
- my $key_len_bits = $self->key_len() * 8;
- $cipher_func =~ s/_aes_/_aes_${key_len_bits}_/;
- $self->cipher_func($cipher_func);
- $self->cipher_needs_iv(1);
-}
-
-sub write_cipher_config {
- my $self = shift;
-
- open my $cfg_fh, '>', CIPHER_CONFIG_FILENAME or
- $self->exit_with_error(130,
- "Could not open configuration file '%s' for writing: %s",
- CIPHER_CONFIG_FILENAME, $!
- );
-
- my $package = $self->package();
- my $prefix_dir = $self->prefix_dir();
- my $ver_str = $self->ver_str();
-
- print $cfg_fh <<"EOT";
-/*============================================================================
- *
- * @{[CIPHER_CONFIG_FILENAME]}
- *
- * DESCRIPTION
- * Cipher configuration file for Filter::Crypto modules.
- *
- * DO NOT EDIT THIS FILE!
- *
- * This file is written by Makefile.PL from its command-line option values
- * and/or default values. Any changes made here will be lost the next time
- * Makefile.PL is run.
- *
- * Created at @{[scalar localtime]} by Perl version $], installed as
- * $^X
- *
- * Configured against $package version $ver_str, installed under
- * $prefix_dir
- *
- *============================================================================*/
-
-EOT
-
- my $cipher_func = $self->cipher_func();
- print $cfg_fh "#define FILTER_CRYPTO_CIPHER_FUNC $cipher_func\n";
-
- if ($self->cipher_needs_iv()) {
- print $cfg_fh "#define FILTER_CRYPTO_NEED_IV 1\n";
- }
- else {
- print $cfg_fh "#define FILTER_CRYPTO_NEED_IV 0\n";
- }
-
- my $key_len = $self->key_len();
- print $cfg_fh "#define FILTER_CRYPTO_KEY_LEN $key_len\n";
-
- my $rc2_key_bits = $self->rc2_key_bits();
- my $rc5_rounds = $self->rc5_rounds();
- if (defined $rc2_key_bits) {
- print $cfg_fh "#define FILTER_CRYPTO_RC2_KEY_BITS $rc2_key_bits\n";
- }
- elsif (defined $rc5_rounds) {
- print $cfg_fh "#define FILTER_CRYPTO_RC5_ROUNDS $rc5_rounds\n";
- }
-
- my($def, $var);
- if ($key_len == 0) {
- $def = '#define FILTER_CRYPTO_USING_PBE 0';
- $var = 'static const unsigned char *filter_crypto_key = NULL;';
- }
- else {
- my $pswd = $self->pswd();
- if (defined $pswd) {
- $def = '#define FILTER_CRYPTO_USING_PBE 1';
- $pswd = $self->format_chars($pswd);
- my $ver_num = $self->ver_num();
- if ($ver_num < 90400) {
- $var = "static unsigned char filter_crypto_pswd[] = {\n" .
- "$pswd\n" .
- "};";
- }
- else {
- $var = "static const unsigned char filter_crypto_pswd[] = {\n" .
- "$pswd\n" .
- "};";
- }
- }
- else {
- $def = '#define FILTER_CRYPTO_USING_PBE 0';
- my $key = $self->key();
- $key = $self->format_chars($key);
- $var = "static const unsigned char filter_crypto_key[] = {\n" .
- "$key\n" .
- "};";
- }
- }
- print $cfg_fh "$def\n\n";
- print $cfg_fh "$var\n";
-
- print $cfg_fh <<'EOT';
-
-/*============================================================================*/
-EOT
-
- close $cfg_fh;
-
- print wrap('', '',
- "Your cipher configuration has been written to the file '" .
- CIPHER_CONFIG_FILENAME . "'. You may want to keep this file in a " .
- "safe place if you ever need to rebuild these modules using the same " .
- "configuration, especially if your key was randomly generated."
- ), "\n\n";
-}
-
-sub format_chars {
- my $self = shift;
- my $chars = shift;
-
- $chars =~ s/(..)/0x$1, /g;
- $chars =~ s/^/ /;
- $chars =~ s/, $//;
- $chars =~ s/((?:0x.., ){8})/$1\n /g;
- $chars =~ s/ \n/\n/g;
- $chars =~ s/\n $//;
-
- return $chars;
-}
-
-sub copy_cipher_config {
- my $self = shift;
- my $cipher_config_file = shift;
-
- if ($cipher_config_file ne CIPHER_CONFIG_FILENAME) {
- copy($cipher_config_file, CIPHER_CONFIG_FILENAME) or
- $self->exit_with_error(131,
- "Could not copy configuration file '%s' to '%s': %s",
- $cipher_config_file, CIPHER_CONFIG_FILENAME, $!
- );
- }
-
- print "\n";
-}
-
-1;
-
-__END__
-
-#===============================================================================
@@ -1,530 +0,0 @@
-#line 1
-#===============================================================================
-#
-# inc/Module/Install/PRIVATE.pm
-#
-# DESCRIPTION
-# Author-specific Module::Install private extension class for CPAN author ID
-# SHAY (Steve Hay).
-#
-# COPYRIGHT
-# Copyright (C) 2004-2008, 2012 Steve Hay. All rights reserved.
-#
-# LICENCE
-# You may distribute under the terms of either the GNU General Public License
-# or the Artistic License, as specified in the LICENCE file.
-#
-#===============================================================================
-
-package Module::Install::PRIVATE;
-
-use 5.006000;
-
-use strict;
-use warnings;
-
-use parent qw(Module::Install::Base);
-
-use Carp qw(croak);
-use Config qw(%Config);
-use Cwd qw(abs_path);
-use File::Basename qw(basename);
-use File::Spec::Functions qw(canonpath catfile);
-use Getopt::Long qw(GetOptions);
-use Pod::Usage qw(pod2usage);
-use Text::Wrap qw(wrap);
-
-#===============================================================================
-# CLASS INITIALIZATION
-#===============================================================================
-
-our($VERSION);
-
-BEGIN {
- $VERSION = '1.07';
-
- # Define protected accessor/mutator methods.
- foreach my $prop (qw(define inc libs opts)) {
- no strict 'refs';
- *$prop = sub {
- use strict 'refs';
- my $self = shift;
- $self->{$prop} = shift if @_;
- return $self->{$prop};
- };
- }
-}
-
-# Indentation for show_found_var() method.
-our $Show_Found_Var_Indent = 37;
-
-#===============================================================================
-# PUBLIC API
-#===============================================================================
-
-# Method to return the instance of this class that it was invoked on, for use in
-# invoking further methods in this class within Makefile.PL. (This method has a
-# suitably unique name to just be autoloaded from Makefile.PL; the other methods
-# do not, so must be invoked on our object to ensure they are dispatched
-# correctly.)
-
-sub get_shay_private_obj {
- return shift;
-}
-
-sub process_opts {
- my($self, $opt_specs, $with_auto_install) = @_;
-
- # Allow options to be introduced with a "/" character on Windows, as is
- # common on those OSes, as well as the default set of characters.
- if ($self->is_win32()) {
- Getopt::Long::Configure('prefix_pattern=(--|-|\+|\/)');
- }
-
- # Deal with these common options immediately; have the rest stored in %opts.
- my $opt_def = 0;
- my %opts = (
- 'defaults' => sub { $ENV{PERL_MM_USE_DEFAULT} = 1; $opt_def = 1 },
- 'version' => sub { $self->exit_with_version() },
- 'help' => sub { $self->exit_with_help() },
- 'manpage' => sub { $self->exit_with_manpage() }
- );
-
- # Make sure that '-v' and '-h' unambiguously mean '--version' and '--help'
- # respectively, even if other option specs beginning with 'v' or 'h' are
- # given in @$opt_specs.
- my @opt_specs = (
- @$opt_specs,
- 'defaults',
- 'version|v',
- 'help|h|?',
- 'manpage|doc'
- );
-
- # Include the Module::AutoInstall options if requested. Also save @ARGV so
- # that it can be temporarily restored for auto_install() later.
- my @SAVARGV = ();
- if ($with_auto_install) {
- # These options are specified in Module::AutoInstall::_init().
- push @opt_specs, (
- 'config:s',
- 'installdeps|install:s',
- 'defaultdeps|default',
- 'checkdeps|check',
- 'skipdeps|skip',
- 'testonly|test'
- );
-
- @SAVARGV = @ARGV;
- }
-
- GetOptions(\%opts, @opt_specs) or
- $self->exit_with_usage();
-
- if ($with_auto_install) {
- # Temporarily restore the original @ARGV for auto_install() since its
- # options will have been removed from @ARGV by GetOptions().
- local @ARGV = @SAVARGV;
- $self->auto_install();
-
- # We are not using Module::AutoInstall's Write() so we have to check for
- # "check only" mode and exit ourselves if it is set.
- if ( exists $opts{'checkdeps'} or
- (exists $ENV{PERL_AUTOINSTALL} and
- " $ENV{PERL_AUTOINSTALL} " =~ /\s--check(?:deps)?\s/o))
- {
- warn("*** Makefile not written in check-only mode.\n");
- exit 0;
- }
-
- # If it appears that Test::Builder has been loaded during the course of
- # the auto-install testing then disable the Test::Builder ending
- # diagnostic code that would otherwise be invoked if the Makefile.PL
- # die()s anytime later. This suppresses a somewhat confusing (given
- # the context) message about the test having died before it could output
- # anything.
- if (my $test = eval { Test::Builder->new() }) {
- $test->no_ending(1);
- }
- }
-
- if ($ENV{PERL_MM_USE_DEFAULT} and $ExtUtils::MakeMaker::VERSION < 5.48_01)
- {
- warn(wrap('', '', "\n" . sprintf(
- 'Warning: %s ignored: requires ExtUtils::MakeMaker version ' .
- '5.48_01 or later',
- $opt_def ? '--defaults option'
- : 'PERL_MM_USE_DEFAULT environment variable'
- )) . "\n\n");
- }
-
- $self->opts(\%opts);
-}
-
-# Method to perform a rudimentary check that a compatible compiler is being used
-# to build this module as was used to build Perl itself. The check is skipped
-# on all platforms except Win32, and is also skipped on Win32 if the compiler
-# used to build Perl is unknown and unguessable.
-# It is good enough, however, to catch the currently rather common situation in
-# which a Win32 user is building this module with Visual C++ Toolkit 2003 or
-# Visual C++ 2005 Express Edition or later for use with ActivePerl, which is
-# known currently to be built with Visual C++ 6.0. These combinations do not
-# work for all modules; see the INSTALL file for details.
-
-# This method is based on code taken from the get_avail_w32compilers() function
-# in the configsmoke.pl script in the Test-Smoke distribution (version 1.19).
-
-sub check_compiler {
- my($self, $exit_on_error) = @_;
-
- my $cc;
- unless ($cc = $self->can_cc()) {
- if ($Config{cc} ne '') {
- $self->exit_with_error(8,
- "OS unsupported: Compiler used to build perl ('%s') not found",
- $Config{cc}
- );
- }
- else {
- $self->exit_with_error(9,
- 'OS unsupported: Compiler used to build perl not specified ' .
- 'in perl configuration'
- );
- }
- }
- $cc = qq["$cc"] if $cc =~ / /o;
-
- return unless $self->is_win32();
-
- my $fmt = "Wrong compiler version ('%s'). Perl was built with version " .
- "'%s'. Please see INSTALL file for details";
- my $msg = '';
- # Perl version 5.6.0 did not have $Config{ccversion} at all on Win32.
- if (exists $Config{ccversion} and $Config{ccversion} ne '') {
- my $ccversion;
- if ($cc =~ /cl(?:\.exe)?"?$/io) {
- my $output = `$cc --version 2>&1`;
- $ccversion = $output =~ /^.*Version\s+([\d.]+)/io ? $1 : '?';
-
- # Visual C++ 6.0 and earlier (having ccversion 12.x and earlier) all
- # used the system's msvcrt.dll, so just check that the major version
- # number is the same. Visual C++ 7.0 onwards (having ccversion 13.x
- # onwards) use msvcr70.dll onwards, so check that the major and
- # minor versions are the same. (Note that from Visual C++ 8.x
- # onwards (having ccversion 14.x onwards) the ccversion is now
- # composed of four numbers separated by dots, not just three. We are
- # only interested in the first two anyway, though.)
- my($major, $minor) = $ccversion =~ /^(\d+)\.(\d+)\./o;
- if (defined $major and defined $minor) {
- if ($major <= 12) {
- if ($Config{ccversion} !~ /^$major\./) {
- $msg = sprintf $fmt, $ccversion, $Config{ccversion};
- }
- }
- elsif ($Config{ccversion} !~ /^$major\.$minor\./) {
- $msg = sprintf $fmt, $ccversion, $Config{ccversion};
- }
- }
- }
- elsif ($cc =~ /bcc32(?:\.exe)?"?$/io) {
- my $output = `$cc --version 2>&1`;
- $ccversion = $output =~ /([\d.]+)/o ? $1 : '?';
-
- # Just check that the major version number is the same.
- my($major) = $ccversion =~ /^(\d+)\./o;
- if (defined $major and $Config{ccversion} !~ /^$major\./) {
- $msg = sprintf $fmt, $ccversion, $Config{ccversion};
- }
- }
- }
- elsif ($Config{gccversion} ne '') {
- my $gccversion;
- if ($cc =~ /gcc(?:\.exe)?"?$/io) {
- chomp($gccversion = `$cc -dumpversion`);
- }
-
- # Just check that the major version number is the same.
- my($major) = $gccversion =~ /^(\d+)\./o;
- if (defined $major and $Config{gccversion} !~ /^$major\./) {
- $msg = sprintf $fmt, $gccversion, $Config{gccversion};
- }
- }
- elsif ($Config{cf_by} eq 'ActiveState') {
- my $ccversion = '?';
- my $vc6version = '12.00.8804';
- if ($cc =~ /cl(?:\.exe)?"?$/io) {
- my $output = `$cc --version 2>&1`;
- $ccversion = $output =~ /^.*Version\s+([\d.]+)/ ? $1 : '?';
- }
-
- # Check the Visual C++ version number as above.
- my($major, $minor) = $ccversion =~ /^(\d+)\.(\d+)\./o;
- if (defined $major and defined $minor) {
- if ($major <= 12) {
- if ($vc6version !~ /^$major\./) {
- $msg = sprintf $fmt, $ccversion, $vc6version;
- }
- }
- elsif ($vc6version !~ /^$major\.$minor\./) {
- $msg = sprintf $fmt, $ccversion, $vc6version;
- }
- }
- }
-
- if ($msg) {
- if ($exit_on_error) {
- $self->exit_with_error(10, "OS unsupported: $msg");
- }
- else {
- warn("Warning: $msg\n");
- }
- }
-}
-
-sub query_scripts {
- my($self, $script_specs) = @_;
-
- my($install_scripts, $multi);
- if (@$script_specs == 1) {
- $install_scripts = $self->opts()->{'install-script'};
- $multi = 0;
- }
- else {
- $install_scripts = $self->opts()->{'install-scripts'};
- $multi = 1;
- }
-
- if (defined $install_scripts) {
- if ($install_scripts =~ /^(?:y|n$)/) {
- $self->show_found_var(
- sprintf('Using specified script%s option', $multi ? 's' : ''),
- $install_scripts
- );
- }
- else {
- $self->exit_with_error(3,
- "Invalid 'install_script%s' option value '%s'",
- $multi ? 's' : '', $install_scripts
- );
- }
- }
-
- foreach my $script_spec (@$script_specs) {
- my($script_name, $default) = $script_spec =~ /^([^=]+)(?:=(y|n))?$/io;
- my $answer;
- if (defined $install_scripts) {
- $answer = $install_scripts eq 'y' ? 1 : 0;
- }
- else {
- $default = 'y' unless defined $default;
- my $question = "Do you want to install '$script_name'?";
- $answer = $self->prompt_yes_no($question, $default);
- }
-
- $self->install_script(catfile('script', $script_name)) if $answer;
- }
- print "\n";
-}
-
-# Method to store the build options in this process' environment so that they
-# are available to the sub-directories' Makefile.PLs when they are run. Note
-# that ExtUtils::MakeMaker's PASTHRU macro is not good enough because that only
-# passes things through when "make Makefile" is run, which is too late for the
-# processing of the LIBS option that Makefile.PL itself handles.
-
-sub setup_env {
- my $self = shift;
-
- $ENV{__SHAY_PRIVATE_DEFINE} = $self->define();
- $ENV{__SHAY_PRIVATE_INC} = $self->inc();
- $ENV{__SHAY_PRIVATE_LIBS} = $self->libs();
-}
-
-#===============================================================================
-# PROTECTED API
-#===============================================================================
-
-sub is_win32 {
- return $^O =~ /MSWin32/io;
-}
-
-sub prompt_yes_no {
- my($self, $question, $default) = @_;
-
- my $answer = $self->prompt_validate(
- -question => $question,
- -default => $default,
- -validate => sub { $_[0] =~ /^(?:y(?:es)?|no?)$/io }
- );
-
- return $answer =~ /y/io ? 1 : 0;
-}
-
-sub prompt_dir {
- my($self, $question, $default) = @_;
-
- my $dir = $self->prompt_validate(
- -question => $question,
- -default => $default,
- -validate => sub { -d $_[0] },
- -errmsg => 'No such directory'
- );
-
- return canonpath(abs_path($dir));
-}
-
-sub prompt_list {
- my($self, $message, $options, $question, $default) = @_;
-
- my $num_options = scalar @$options;
- my $len = length $num_options;
-
- my %options = map { $_->[0] => 1 } @$options;
- my $num_unique_options = scalar keys %options;
- if ($num_unique_options != $num_options) {
- $self->exit_with_error(4, 'Options in list are not unique');
- }
-
- my $default_num = 0;
- for (my $i = 1; $i <= $num_options; $i++) {
- $message .= sprintf "\n [%${len}d] %s", $i, $options->[$i - 1][1];
- $default_num = $i if $options->[$i - 1][0] eq $default;
- }
-
- if ($default_num == 0) {
- $self->exit_with_error(5, "Invalid default response '%s'", $default);
- }
-
- my $answer_num = $self->prompt_validate(
- -message => $message,
- -question => $question,
- -default => $default_num,
- -validate => sub {
- $_[0] =~ /^[1-9](?:\d+)?$/ and $_[0] <= $num_options
- }
- );
-
- return $options->[$answer_num - 1][0];
-}
-
-{
- my %defaults = (
- -question => '?',
- -default => '',
- -validate => sub { 1 },
- -errmsg => 'Invalid response'
- );
-
- sub prompt_validate {
- my $self = shift;
- my %args = (%defaults, @_);
-
- if (exists $args{-message}) {
- print wrap('', '', $args{-message}), "\n";
- }
-
- my $input;
- until (defined $input) {
- $input = $self->prompt($args{-question}, $args{-default});
- unless ($args{-validate}->($input)) {
- if ($self->use_default_response()) {
- $self->exit_with_error(7,
- "Invalid default response '%s'", $args{-default}
- );
- }
- else {
- print wrap('', '', $args{-errmsg}), "\n";
- $input = undef;
- }
- }
- }
-
- return $input;
- }
-}
-
-sub show_found_var {
- my($self, $msg, $var) = @_;
- local $Text::Wrap::break = qr{\s|(?<=[\\\\/]).{0}};
- print wrap('', ' ' x $Show_Found_Var_Indent,
- "$msg " . '.' x ($Show_Found_Var_Indent - length($msg) - 2) . " $var"
- ), "\n";
-}
-
-sub exit_with_version {
- my $self = shift;
-
- printf "This is %s v%s (using %s v%s).\n\n",
- basename($0), $main::VERSION, ref $self, $self->VERSION();
-
- print "Copyright (C) $main::YEAR Steve Hay. All rights reserved.\n\n";
-
- print wrap('', '',
- "This script is free software; you can redistribute it and/or modify " .
- "it under the same terms as Perl itself, i.e. under the terms of " .
- "either the GNU General Public License or the Artistic License, as " .
- "specified in the LICENCE file.\n\n"
- );
-
- exit 1;
-}
-
-sub exit_with_help {
- my $self = shift;
- pod2usage(
- -exitval => 1,
- -verbose => 1
- );
-}
-
-sub exit_with_manpage {
- my $self = shift;
- pod2usage(
- -exitval => 1,
- -verbose => 2
- );
-}
-
-sub exit_with_usage {
- my $self = shift;
- pod2usage(
- -exitval => 2,
- -verbose => 0
- );
-}
-
-sub exit_with_error {
- my($self, $num, $msg) = splice @_, 0, 3;
- $msg = sprintf $msg, @_ if @_;
- # Load Carp::Heavy now, otherwise (before Perl 5.8.7) croak() clobbers $!
- # when loading it.
- require Carp::Heavy;
- $! = $num;
- croak("Error ($num): $msg");
-}
-
-# This method is based on code taken from the prompt() function in the standard
-# library module ExtUtils::MakeMaker (version 6.17).
-
-sub use_default_response {
- my $self = shift;
- return($ENV{PERL_MM_USE_DEFAULT} or (not $self->_isa_tty() and eof STDIN));
-}
-
-#===============================================================================
-# PRIVATE API
-#===============================================================================
-
-# This method is based on code taken from the prompt() function in the standard
-# library module ExtUtils::MakeMaker (version 6.17).
-
-sub _isa_tty {
- my $self = shift;
- return(-t STDIN and (-t STDOUT or not (-f STDOUT or -c STDOUT)));
-}
-
-1;
-
-__END__
-
-#===============================================================================
@@ -1,29 +0,0 @@
-#line 1
-package Module::Install::Scripts;
-
-use strict 'vars';
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.06';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub install_script {
- my $self = shift;
- my $args = $self->makemaker_args;
- my $exe = $args->{EXE_FILES} ||= [];
- foreach ( @_ ) {
- if ( -f $_ ) {
- push @$exe, $_;
- } elsif ( -d 'script' and -f "script/$_" ) {
- push @$exe, "script/$_";
- } else {
- die("Cannot find script '$_'");
- }
- }
-}
-
-1;
@@ -1,470 +0,0 @@
-#line 1
-package Module::Install;
-
-# For any maintainers:
-# The load order for Module::Install is a bit magic.
-# It goes something like this...
-#
-# IF ( host has Module::Install installed, creating author mode ) {
-# 1. Makefile.PL calls "use inc::Module::Install"
-# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
-# 3. The installed version of inc::Module::Install loads
-# 4. inc::Module::Install calls "require Module::Install"
-# 5. The ./inc/ version of Module::Install loads
-# } ELSE {
-# 1. Makefile.PL calls "use inc::Module::Install"
-# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
-# 3. The ./inc/ version of Module::Install loads
-# }
-
-use 5.005;
-use strict 'vars';
-use Cwd ();
-use File::Find ();
-use File::Path ();
-
-use vars qw{$VERSION $MAIN};
-BEGIN {
- # All Module::Install core packages now require synchronised versions.
- # This will be used to ensure we don't accidentally load old or
- # different versions of modules.
- # This is not enforced yet, but will be some time in the next few
- # releases once we can make sure it won't clash with custom
- # Module::Install extensions.
- $VERSION = '1.06';
-
- # Storage for the pseudo-singleton
- $MAIN = undef;
-
- *inc::Module::Install::VERSION = *VERSION;
- @inc::Module::Install::ISA = __PACKAGE__;
-
-}
-
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- #-------------------------------------------------------------
- # all of the following checks should be included in import(),
- # to allow "eval 'require Module::Install; 1' to test
- # installation of Module::Install. (RT #51267)
- #-------------------------------------------------------------
-
- # Whether or not inc::Module::Install is actually loaded, the
- # $INC{inc/Module/Install.pm} is what will still get set as long as
- # the caller loaded module this in the documented manner.
- # If not set, the caller may NOT have loaded the bundled version, and thus
- # they may not have a MI version that works with the Makefile.PL. This would
- # result in false errors or unexpected behaviour. And we don't want that.
- my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
- unless ( $INC{$file} ) { die <<"END_DIE" }
-
-Please invoke ${\__PACKAGE__} with:
-
- use inc::${\__PACKAGE__};
-
-not:
-
- use ${\__PACKAGE__};
-
-END_DIE
-
- # This reportedly fixes a rare Win32 UTC file time issue, but
- # as this is a non-cross-platform XS module not in the core,
- # we shouldn't really depend on it. See RT #24194 for detail.
- # (Also, this module only supports Perl 5.6 and above).
- eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
-
- # If the script that is loading Module::Install is from the future,
- # then make will detect this and cause it to re-run over and over
- # again. This is bad. Rather than taking action to touch it (which
- # is unreliable on some platforms and requires write permissions)
- # for now we should catch this and refuse to run.
- if ( -f $0 ) {
- my $s = (stat($0))[9];
-
- # If the modification time is only slightly in the future,
- # sleep briefly to remove the problem.
- my $a = $s - time;
- if ( $a > 0 and $a < 5 ) { sleep 5 }
-
- # Too far in the future, throw an error.
- my $t = time;
- if ( $s > $t ) { die <<"END_DIE" }
-
-Your installer $0 has a modification time in the future ($s > $t).
-
-This is known to create infinite loops in make.
-
-Please correct this, then run $0 again.
-
-END_DIE
- }
-
-
- # Build.PL was formerly supported, but no longer is due to excessive
- # difficulty in implementing every single feature twice.
- if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
-
-Module::Install no longer supports Build.PL.
-
-It was impossible to maintain duel backends, and has been deprecated.
-
-Please remove all Build.PL files and only use the Makefile.PL installer.
-
-END_DIE
-
- #-------------------------------------------------------------
-
- # To save some more typing in Module::Install installers, every...
- # use inc::Module::Install
- # ...also acts as an implicit use strict.
- $^H |= strict::bits(qw(refs subs vars));
-
- #-------------------------------------------------------------
-
- unless ( -f $self->{file} ) {
- foreach my $key (keys %INC) {
- delete $INC{$key} if $key =~ /Module\/Install/;
- }
-
- local $^W;
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- local $^W;
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{'inc/Module/Install.pm'};
- delete $INC{'Module/Install.pm'};
-
- # Save to the singleton
- $MAIN = $self;
-
- return 1;
-}
-
-sub autoload {
- my $self = shift;
- my $who = $self->_caller;
- my $cwd = Cwd::cwd();
- my $sym = "${who}::AUTOLOAD";
- $sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
- if ( my $code = $sym->{$pwd} ) {
- # Delegate back to parent dirs
- goto &$code unless $cwd eq $pwd;
- }
- unless ($$sym =~ s/([^:]+)$//) {
- # XXX: it looks like we can't retrieve the missing function
- # via $$sym (usually $main::AUTOLOAD) in this case.
- # I'm still wondering if we should slurp Makefile.PL to
- # get some context or not ...
- my ($package, $file, $line) = caller;
- die <<"EOT";
-Unknown function is found at $file line $line.
-Execution of $file aborted due to runtime errors.
-
-If you're a contributor to a project, you may need to install
-some Module::Install extensions from CPAN (or other repository).
-If you're a user of a module, please contact the author.
-EOT
- }
- my $method = $1;
- if ( uc($method) eq $method ) {
- # Do nothing
- return;
- } elsif ( $method =~ /^_/ and $self->can($method) ) {
- # Dispatch to the root M:I class
- return $self->$method(@_);
- }
-
- # Dispatch to the appropriate plugin
- unshift @_, ( $self, $1 );
- goto &{$self->can('call')};
- };
-}
-
-sub preload {
- my $self = shift;
- unless ( $self->{extensions} ) {
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- );
- }
-
- my @exts = @{$self->{extensions}};
- unless ( @exts ) {
- @exts = $self->{admin}->load_all_extensions;
- }
-
- my %seen;
- foreach my $obj ( @exts ) {
- while (my ($method, $glob) = each %{ref($obj) . '::'}) {
- next unless $obj->can($method);
- next if $method =~ /^_/;
- next if $method eq uc($method);
- $seen{$method}++;
- }
- }
-
- my $who = $self->_caller;
- foreach my $name ( sort keys %seen ) {
- local $^W;
- *{"${who}::$name"} = sub {
- ${"${who}::AUTOLOAD"} = "${who}::$name";
- goto &{"${who}::AUTOLOAD"};
- };
- }
-}
-
-sub new {
- my ($class, %args) = @_;
-
- delete $INC{'FindBin.pm'};
- {
- # to suppress the redefine warning
- local $SIG{__WARN__} = sub {};
- require FindBin;
- }
-
- # ignore the prefix on extension modules built from top level.
- my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
- delete $args{prefix};
- }
- return $args{_self} if $args{_self};
-
- $args{dispatch} ||= 'Admin';
- $args{prefix} ||= 'inc';
- $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
- $args{bundle} ||= 'inc/BUNDLES';
- $args{base} ||= $base_path;
- $class =~ s/^\Q$args{prefix}\E:://;
- $args{name} ||= $class;
- $args{version} ||= $class->VERSION;
- unless ( $args{path} ) {
- $args{path} = $args{name};
- $args{path} =~ s!::!/!g;
- }
- $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
- $args{wrote} = 0;
-
- bless( \%args, $class );
-}
-
-sub call {
- my ($self, $method) = @_;
- my $obj = $self->load($method) or return;
- splice(@_, 0, 2, $obj);
- goto &{$obj->can($method)};
-}
-
-sub load {
- my ($self, $method) = @_;
-
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- ) unless $self->{extensions};
-
- foreach my $obj (@{$self->{extensions}}) {
- return $obj if $obj->can($method);
- }
-
- my $admin = $self->{admin} or die <<"END_DIE";
-The '$method' method does not exist in the '$self->{prefix}' path!
-Please remove the '$self->{prefix}' directory and run $0 again to load it.
-END_DIE
-
- my $obj = $admin->load($method, 1);
- push @{$self->{extensions}}, $obj;
-
- $obj;
-}
-
-sub load_extensions {
- my ($self, $path, $top) = @_;
-
- my $should_reload = 0;
- unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
- unshift @INC, $self->{prefix};
- $should_reload = 1;
- }
-
- foreach my $rv ( $self->find_extensions($path) ) {
- my ($file, $pkg) = @{$rv};
- next if $self->{pathnames}{$pkg};
-
- local $@;
- my $new = eval { local $^W; require $file; $pkg->can('new') };
- unless ( $new ) {
- warn $@ if $@;
- next;
- }
- $self->{pathnames}{$pkg} =
- $should_reload ? delete $INC{$file} : $INC{$file};
- push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
- }
-
- $self->{extensions} ||= [];
-}
-
-sub find_extensions {
- my ($self, $path) = @_;
-
- my @found;
- File::Find::find( sub {
- my $file = $File::Find::name;
- return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
- my $subpath = $1;
- return if lc($subpath) eq lc($self->{dispatch});
-
- $file = "$self->{path}/$subpath.pm";
- my $pkg = "$self->{name}::$subpath";
- $pkg =~ s!/!::!g;
-
- # If we have a mixed-case package name, assume case has been preserved
- # correctly. Otherwise, root through the file to locate the case-preserved
- # version of the package name.
- if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
- my $content = Module::Install::_read($subpath . '.pm');
- my $in_pod = 0;
- foreach ( split //, $content ) {
- $in_pod = 1 if /^=\w/;
- $in_pod = 0 if /^=cut/;
- next if ($in_pod || /^=cut/); # skip pod text
- next if /^\s*#/; # and comments
- if ( m/^\s*package\s+($pkg)\s*;/i ) {
- $pkg = $1;
- last;
- }
- }
- }
-
- push @found, [ $file, $pkg ];
- }, $path ) if -d $path;
-
- @found;
-}
-
-
-
-
-
-#####################################################################
-# Common Utility Functions
-
-sub _caller {
- my $depth = 0;
- my $call = caller($depth);
- while ( $call eq __PACKAGE__ ) {
- $depth++;
- $call = caller($depth);
- }
- return $call;
-}
-
-# Done in evals to avoid confusing Perl::MinimumVersion
-eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
-sub _read {
- local *FH;
- open( FH, '<', $_[0] ) or die "open($_[0]): $!";
- my $string = do { local $/; <FH> };
- close FH or die "close($_[0]): $!";
- return $string;
-}
-END_NEW
-sub _read {
- local *FH;
- open( FH, "< $_[0]" ) or die "open($_[0]): $!";
- my $string = do { local $/; <FH> };
- close FH or die "close($_[0]): $!";
- return $string;
-}
-END_OLD
-
-sub _readperl {
- my $string = Module::Install::_read($_[0]);
- $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
- $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
- $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
- return $string;
-}
-
-sub _readpod {
- my $string = Module::Install::_read($_[0]);
- $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
- return $string if $_[0] =~ /\.pod\z/;
- $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
- $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
- $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
- $string =~ s/^\n+//s;
- return $string;
-}
-
-# Done in evals to avoid confusing Perl::MinimumVersion
-eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
-sub _write {
- local *FH;
- open( FH, '>', $_[0] ) or die "open($_[0]): $!";
- foreach ( 1 .. $#_ ) {
- print FH $_[$_] or die "print($_[0]): $!";
- }
- close FH or die "close($_[0]): $!";
-}
-END_NEW
-sub _write {
- local *FH;
- open( FH, "> $_[0]" ) or die "open($_[0]): $!";
- foreach ( 1 .. $#_ ) {
- print FH $_[$_] or die "print($_[0]): $!";
- }
- close FH or die "close($_[0]): $!";
-}
-END_OLD
-
-# _version is for processing module versions (eg, 1.03_05) not
-# Perl versions (eg, 5.8.1).
-sub _version ($) {
- my $s = shift || 0;
- my $d =()= $s =~ /(\.)/g;
- if ( $d >= 2 ) {
- # Normalise multipart versions
- $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
- }
- $s =~ s/^(\d+)\.?//;
- my $l = $1 || 0;
- my @v = map {
- $_ . '0' x (3 - length $_)
- } $s =~ /(\d{1,3})\D?/g;
- $l = $l . '.' . join '', @v if @v;
- return $l + 0;
-}
-
-sub _cmp ($$) {
- _version($_[1]) <=> _version($_[2]);
-}
-
-# Cloned from Params::Util::_CLASS
-sub _CLASS ($) {
- (
- defined $_[0]
- and
- ! ref $_[0]
- and
- $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
- ) ? $_[0] : undef;
-}
-
-1;
-
-# Copyright 2008 - 2012 Adam Kennedy.
@@ -7,7 +7,7 @@
# distribution.
#
# COPYRIGHT
-# Copyright (C) 2004-2010, 2012 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2010, 2012, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -17,7 +17,7 @@
package Filter::Crypto;
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -29,7 +29,7 @@ use warnings;
our($VERSION);
BEGIN {
- $VERSION = '2.03';
+ $VERSION = '2.06';
}
1;
@@ -116,7 +116,7 @@ itself.
This technique can I<never> completely hide the original unencrypted source code
from people sufficiently determined to get it. The most it can hope for is to
hide it from casual prying eyes, and to outdo everyone who is using a
-precompiled Perl (at least from "regular" sources) and everyone who is not
+precompiled perl (at least from "regular" sources) and everyone who is not
knowledgeable enough to suitably modify the Perl source code before compiling
their own.
@@ -127,9 +127,9 @@ it must be decrypted, otherwise the script cannot be run. This means that at
some stage every part of the script must be held in memory in an unencrypted
state, so anyone with the appropriate debugging skills will be able to get it.
-If Perl was built with DEBUGGING then running the script with the Perl's B<-Dp>
-command-line option makes this much easier. Even without a DEBUGGING Perl, the
-script can still be run under the Perl debugger (Perl's B<-d> command-line
+If perl was built with DEBUGGING then running the script with the perl's B<-Dp>
+command-line option makes this much easier. Even without a DEBUGGING perl, the
+script can still be run under the Perl debugger (perl's B<-d> command-line
option), whose C<l> command will list the (decrypted) source code that was fed
to the parser.
@@ -153,11 +153,11 @@ following:
=item *
-Running under a Perl that was built with DEBUGGING (C<-DDEBUGGING>);
+Running under a perl that was built with DEBUGGING (C<-DDEBUGGING>);
=item *
-Running under a Perl with DEBUGGING flags enabled (B<-D> or $^D);
+Running under a perl with DEBUGGING flags enabled (B<-D> or $^D);
=item *
@@ -169,23 +169,23 @@ Running under the Perl compiler backend (B<-MO=Deparse>).
=back
-You should also not use a Perl that was built with C debugging support enabled
+You should also not use a perl that was built with C debugging support enabled
(e.g. B<gcc>'s B<-g> option, or B<cl.exe>'s B</Zi> option) and should strip the
-Perl executable to remove all symbols (e.g. B<gcc>'s B<-s> option).
+perl executable to remove all symbols (e.g. B<gcc>'s B<-s> option).
None of the above checks are infallible, however, because unless the source code
-decryption filter module is statically linked against the Perl executable then
-users can always replace the Perl executable being used to run the script with
+decryption filter module is statically linked against the perl executable then
+users can always replace the perl executable being used to run the script with
their own version, perhaps hacked in such a way as to work around the above
checks, and thus with debugging/deparsing capabilities enabled. Such a hacked
-version of the Perl executable can certainly be produced since Perl is open
+version of the perl executable can certainly be produced since Perl is open
source itself.
In fact, it is not difficult for suitably experienced hackers to produce a
-modified Perl executable that makes it absolutely trivial for them to retrieve
+modified perl executable that makes it absolutely trivial for them to retrieve
the I<original> unencrypted source code with comments, whitespace and all (i.e.
not just a deparsed reconstruction of it). One example that was mentioned in
-the perl5-porters thread cited above is to modify the Perl executable to simply
+the perl5-porters thread cited above is to modify the perl executable to simply
print each line of the decrypted source stream that is fed to the parser, rather
than parsing and running it!
@@ -219,16 +219,16 @@ EXISTING ENCRYPTED FILES WILL NEED TO BE RE-ENCRYPTED.>
Patches, bug reports, suggestions or any other feedback is welcome.
Bugs can be reported on the CPAN Request Tracker at
-F<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Filter-Crypto>.
+F<https://rt.cpan.org/Public/Bug/Report.html?Queue=Filter-Crypto>.
Open bugs on the CPAN Request Tracker can be viewed at
-F<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Filter-Crypto>.
+F<https://rt.cpan.org/Public/Dist/Display.html?Status=Active;Dist=Filter-Crypto>.
-Please test this distribution. See CPAN Testers at F<http://testers.cpan.org/>
-for details of how to get involved.
+Please test this distribution. See CPAN Testers Reports at
+F<http://www.cpantesters.org/> for details of how to get involved.
-Previous test results on CPAN Testers can be viewed at
-F<http://testers.cpan.org/search?request=dist&dist=Filter-Crypto>.
+Previous test results on CPAN Testers Reports can be viewed at
+F<http://www.cpantesters.org/distro/F/Filter-Crypto.html>.
Please rate this distribution on CPAN Ratings at
F<http://cpanratings.perl.org/rate/?distribution=Filter-Crypto>.
@@ -256,6 +256,10 @@ Filter::Crypto::Decrypt module itself was based.
The latest version of this module is available from CPAN (see
L<perlmodlib/"CPAN"> for details) at
+F<https://metacpan.org/release/Filter-Crypto> or
+
+F<http://search.cpan.org/dist/Filter-Crypto/> or
+
F<http://www.cpan.org/authors/id/S/SH/SHAY/> or
F<http://www.cpan.org/modules/by-module/Filter/>.
@@ -270,7 +274,7 @@ Steve Hay E<lt>shay@cpan.orgE<gt>
=head1 COPYRIGHT
-Copyright (C) 2004-2010, 2012-2013 Steve Hay. All rights reserved.
+Copyright (C) 2004-2010, 2012-2014 Steve Hay. All rights reserved.
=head1 LICENCE
@@ -280,11 +284,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 2.03
+Version 2.06
=head1 DATE
-08 Jul 2013
+30 May 2014
=head1 HISTORY
@@ -8,7 +8,7 @@
# use in creating PAR archives in which the Perl files are encrypted.
#
# COPYRIGHT
-# Copyright (C) 2004-2008, 2012 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2008, 2012, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -18,7 +18,7 @@
package PAR::Filter::Crypto;
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -38,7 +38,7 @@ our(@ISA, $VERSION);
BEGIN {
@ISA = qw(PAR::Filter);
- $VERSION = '1.07';
+ $VERSION = '1.08';
}
#===============================================================================
@@ -46,7 +46,7 @@ BEGIN {
#===============================================================================
# This method is based on the apply() method in the PAR::Filter::Bytecode module
-# in the PAR distribution (version 0.85).
+# in the PAR::Packer distribution (version 1.017).
sub apply {
my($class, $ref, $filename, $name) = @_;
@@ -245,7 +245,7 @@ L<Filter::Crypto>.
=head1 ACKNOWLEDGEMENTS
The C<apply()> method is based on that in the PAR::Filter::Bytecode module in
-the PAR distribution (version 0.85), written by Autrijus Tang.
+the PAR::Packer distribution (version 1.017), written by Audrey Tang.
=head1 AUTHOR
@@ -253,7 +253,7 @@ Steve Hay E<lt>shay@cpan.orgE<gt>
=head1 COPYRIGHT
-Copyright (C) 2004-2008, 2012 Steve Hay. All rights reserved.
+Copyright (C) 2004-2008, 2012, 2014 Steve Hay. All rights reserved.
=head1 LICENCE
@@ -263,11 +263,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 1.07
+Version 1.08
=head1 DATE
-02 Mar 2012
+16 May 2014
=head1 HISTORY
@@ -8,7 +8,7 @@
# still runnable, format to hide the source code from casual prying eyes.
#
# COPYRIGHT
-# Copyright (C) 2004-2006, 2012 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2006, 2012, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -16,7 +16,7 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -28,6 +28,7 @@ use File::Basename qw(basename fileparse);
use File::Copy qw(copy);
use File::Find qw(find);
use File::Spec::Functions qw(canonpath catfile file_name_is_absolute rel2abs);
+use File::Temp qw(tempfile);
use Filter::Crypto;
use Filter::Crypto::CryptFile qw(:DEFAULT $ErrStr);
use Getopt::Long qw(GetOptions);
@@ -43,6 +44,7 @@ use constant WARNING_TYPE_SEVERE => 1;
sub get_input_files($$$);
sub resolve_file_expr($$);
+sub show_result();
sub show_warning($$$@);
sub exit_with_version();
sub exit_with_help();
@@ -54,8 +56,12 @@ sub exit_with_error(@);
# INITIALIZATION
#===============================================================================
-our $VERSION = '1.03';
-our $YEAR = '2004-2006, 2012';
+our($VERSION, $YEAR);
+
+BEGIN {
+ $VERSION = '1.05';
+ $YEAR = '2004-2006, 2012, 2014';
+}
#===============================================================================
# MAIN PROGRAM
@@ -67,7 +73,7 @@ MAIN: {
# Allow options to be introduced with a "/" character on Windows, as is
# common on those OSes, as well as the default set of characters.
- if ($^O =~ /MSWin32/io) {
+ if ($^O eq 'MSWin32') {
Getopt::Long::Configure('prefix_pattern=(--|-|\+|\/)');
}
@@ -187,15 +193,7 @@ MAIN: {
binmode STDIN;
if (crypt_file(\*STDIN, $out_file, $crypt_mode)) {
- unless ($silent) {
- print STDERR "OK";
-
- # There may be a message left in $ErrStr even after crypt_file()
- # completes successfully, so output that too if there is.
- print STDERR " ($ErrStr)" if $ErrStr ne '';
-
- print STDERR "\n";
- }
+ show_result() unless $silent;
}
else {
show_warning($silent, WARNING_TYPE_SEVERE, '-',
@@ -256,24 +254,14 @@ MAIN: {
exit 0;
};
- # Delay the loading of File::Temp until it is actually
- # required because it is not a standard module in 5.6.0
- # so it might not be available. We would not want to
- # stop the rest of the script from working just because
- # of this, though.
- unless (eval { require File::Temp; 1 }) {
- exit_with_error(3,
- "Can't use --edit-mode=tempfile without " .
- "File::Temp"
- );
- }
-
# Create the temporary file in same directory as the
# input file to be sure the rename() done later works.
- ($temp_fh, $temp_file) =
- File::Temp::tempfile("$file.XXXXXXXX");
+ ($temp_fh, $temp_file) = tempfile("$file.XXXXXXXX");
+
+ my $num_bytes =
+ crypt_file($file, $temp_fh, $crypt_mode);
- unless (crypt_file($file, $temp_fh, $crypt_mode)) {
+ unless (defined $num_bytes) {
show_warning($silent, WARNING_TYPE_SEVERE, $file,
"crypt_file() failed: %s", $ErrStr
);
@@ -289,6 +277,23 @@ MAIN: {
);
}
+ # If no output was written because the file was already
+ # in the requested state then just remove the temporary
+ # file; there is nothing more to do.
+ if ($num_bytes == 0 and
+ ($crypt_mode == CRYPT_MODE_ENCRYPTED or
+ $crypt_mode == CRYPT_MODE_DECRYPTED))
+ {
+ show_result() unless $silent;
+ unless (unlink $temp_file) {
+ show_warning($silent, WARNING_TYPE_NORMAL,
+ $file, "Can't delete temporary file " .
+ "'%s': %s", $temp_file, $!
+ );
+ }
+ next;
+ }
+
# Get the input file's permissions and set them on the
# temporary file, so that when it is renamed to the
# input file the new input file has the same permissions
@@ -315,7 +320,7 @@ MAIN: {
# the following rename() to be writable, so make sure it
# is. (On other systems this is controlled by the
# permissions on the parent directory.)
- if ($^O =~ /MSWin32/io and not -w $file) {
+ if ($^O eq 'MSWin32' and not -w $file) {
unless (chmod $mode | 0200, $file) {
show_warning($silent, WARNING_TYPE_SEVERE,
$file, "Can't make file writable: %s", $!
@@ -356,15 +361,7 @@ MAIN: {
}
}
- unless ($silent) {
- print STDERR "OK";
-
- # There may be a message left in $ErrStr even after crypt_file()
- # completes successfully, so output that too if there is.
- print STDERR " ($ErrStr)" if $ErrStr ne '';
-
- print STDERR "\n";
- }
+ show_result() unless $silent;
}
}
@@ -390,7 +387,7 @@ sub get_input_files($$$) {
warn "No such file '$spec'\n";
}
}
- elsif ($spec !~ /(?<!\\)[?*[]/) {
+ elsif ($spec !~ /(?<!\\)[?*[]/o) {
my $found = 0;
foreach my $dir (@$dirs) {
my $file = rel2abs($spec, $dir);
@@ -467,20 +464,30 @@ sub resolve_file_expr($$) {
my $new_file = $expr;
$new_file =~ s/(?<!\\)\[/$extension/g;
- $new_file =~ s/\\\[/[/g;
+ $new_file =~ s/\\\[/[/go;
$new_file =~ s/\*/$filename/g;
$new_file =~ s/\?/$basename/g;
return $new_file;
}
+sub show_result() {
+ print STDERR "OK";
+
+ # There may be a message left in $ErrStr even after crypt_file() completes
+ # successfully, so output that too if there is.
+ print STDERR " ($ErrStr)" if $ErrStr ne '';
+
+ print STDERR "\n";
+}
+
sub show_warning($$$@) {
my($silent, $type, $file, $msg) = splice @_, 0, 4;
$msg = sprintf $msg, @_ if @_;
my $hdr = '';
- $hdr = "$file: " if $silent;
+ $hdr = "$file: " unless $silent;
if ($type == WARNING_TYPE_NORMAL) {
$hdr .= "Warning: ";
}
@@ -743,9 +750,6 @@ if at all possible). Combined with, say, B<--crypt-mode=encrypted>, this mode
can therefore safely be used to run, and, if necessary, re-run, on a set of
input files until they have all be successfully encrypted.
-Note that the "tempfile" mode requires the File::Temp module, which is only a
-standard module from perl 5.6.1 onwards.
-
This option only applies when input files are being processed "in-place", and
implies the B<--in-place> option if that is not already present.
@@ -945,9 +949,10 @@ given.
=item Can't delete temporary file '%s': %s
(W) The specified temporary file could not be deleted during the clean up of
-temporary files just before exiting when a SIGINT has been caught. The system
-error message corresponding to the standard C library C<errno> variable is also
-given.
+temporary files just before exiting when a SIGINT has been caught, or when
+removing an unneeded temporary file when an input file was found to already be
+in the requested state. The system error message corresponding to the standard
+C library C<errno> variable is also given.
=item Can't open list file '%s' for reading: %s
@@ -956,13 +961,6 @@ from which to read the list of input file specifiers could not be opened for
reading. The system error message corresponding to the standard C library
C<errno> variable is also given.
-=item Can't use --edit-mode=tempfile without File::Temp
-
-(F) The File::Temp module could not be loaded, without which the B<--edit-mode>
-option value "tempfile" cannot be used. Either install the File::Temp module
-(it is actually a standard module from perl 5.6.1 onwards) or use the "memory"
-option value instead.
-
=item Caught SIGINT. Cleaning up temporary files before exiting
(W) The script has received an "interrupt" signal, e.g. the user may have
@@ -1098,7 +1096,7 @@ Steve Hay E<lt>shay@cpan.orgE<gt>
=head1 COPYRIGHT
-Copyright (C) 2004-2006, 2012 Steve Hay. All rights reserved.
+Copyright (C) 2004-2006, 2012, 2014 Steve Hay. All rights reserved.
=head1 LICENCE
@@ -1108,11 +1106,11 @@ License or the Artistic License, as specified in the F<LICENCE> file.
=head1 VERSION
-Version 1.03
+Version 1.05
=head1 DATE
-20 Mar 2012
+16 May 2014
=head1 HISTORY
@@ -1,58 +0,0 @@
-#!perl
-#===============================================================================
-#
-# t/01_constants.t
-#
-# DESCRIPTION
-# Test script to check autoloading of constants.
-#
-# COPYRIGHT
-# Copyright (C) 2004-2006 Steve Hay. All rights reserved.
-#
-# LICENCE
-# You may distribute under the terms of either the GNU General Public License
-# or the Artistic License, as specified in the LICENCE file.
-#
-#===============================================================================
-
-use 5.006000;
-
-use strict;
-use warnings;
-
-use Cwd qw(abs_path);
-use File::Spec::Functions qw(canonpath catdir catfile updir);
-use FindBin qw($Bin);
-use Test::More;
-
-#===============================================================================
-# INITIALIZATION
-#===============================================================================
-
-BEGIN {
- my $top_dir = canonpath(abs_path(catdir($Bin, updir())));
- my $lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');
-
- if (-f catfile($lib_dir, 'CryptFile.pm')) {
- require Filter::Crypto::CryptFile;
- Filter::Crypto::CryptFile->import();
- plan tests => 5;
- }
- else {
- plan skip_all => 'CryptFile component not built';
- }
-}
-
-#===============================================================================
-# MAIN PROGRAM
-#===============================================================================
-
-MAIN: {
- ok(eval { CRYPT_MODE_AUTO(); 1 }, 'CRYPT_MODE_AUTO flag');
- ok(eval { CRYPT_MODE_DECRYPT(); 1 }, 'CRYPT_MODE_DECRYPT flag');
- ok(eval { CRYPT_MODE_ENCRYPT(); 1 }, 'CRYPT_MODE_ENCRYPT flag');
- ok(eval { CRYPT_MODE_DECRYPTED(); 1 }, 'CRYPT_MODE_DECRYPTED flag');
- ok(eval { CRYPT_MODE_ENCRYPTED(); 1 }, 'CRYPT_MODE_ENCRYPTED flag');
-}
-
-#===============================================================================
@@ -0,0 +1,58 @@
+#!perl
+#===============================================================================
+#
+# t/01_imports_01.t
+#
+# DESCRIPTION
+# Test script to check import options.
+#
+# COPYRIGHT
+# Copyright (C) 2004-2006, 2014 Steve Hay. All rights reserved.
+#
+# LICENCE
+# You may distribute under the terms of either the GNU General Public License
+# or the Artistic License, as specified in the LICENCE file.
+#
+#===============================================================================
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Cwd qw(abs_path);
+use File::Spec::Functions qw(canonpath catdir catfile updir);
+use FindBin qw($Bin);
+use Test::More;
+
+#===============================================================================
+# INITIALIZATION
+#===============================================================================
+
+BEGIN {
+ my $top_dir = canonpath(abs_path(catdir($Bin, updir())));
+ my $lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');
+
+ if (-f catfile($lib_dir, 'CryptFile.pm')) {
+ plan tests => 7;
+ require_ok('Filter::Crypto::CryptFile');
+ }
+ else {
+ plan skip_all => 'CryptFile component not built';
+ }
+}
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+MAIN: {
+ ok(!defined &main::crypt_file, 'crypt_file is not imported');
+ ok(!eval { CRYPT_MODE_AUTO(); 1 }, 'CRYPT_MODE_AUTO is not imported');
+ ok(!eval { CRYPT_MODE_DECRYPT(); 1 }, 'CRYPT_MODE_DECRYPT is not imported');
+ ok(!eval { CRYPT_MODE_ENCRYPT(); 1 }, 'CRYPT_MODE_ENCRYPT is not imported');
+ ok(!eval { CRYPT_MODE_DECRYPTED(); 1 }, 'CRYPT_MODE_DECRYPTED is not imported');
+ ok(!eval { CRYPT_MODE_ENCRYPTED(); 1 }, 'CRYPT_MODE_ENCRYPTED is not imported');
+}
+
+#===============================================================================
@@ -0,0 +1,58 @@
+#!perl
+#===============================================================================
+#
+# t/01_imports_02.t
+#
+# DESCRIPTION
+# Test script to check import options.
+#
+# COPYRIGHT
+# Copyright (C) 2014 Steve Hay. All rights reserved.
+#
+# LICENCE
+# You may distribute under the terms of either the GNU General Public License
+# or the Artistic License, as specified in the LICENCE file.
+#
+#===============================================================================
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Cwd qw(abs_path);
+use File::Spec::Functions qw(canonpath catdir catfile updir);
+use FindBin qw($Bin);
+use Test::More;
+
+#===============================================================================
+# INITIALIZATION
+#===============================================================================
+
+BEGIN {
+ my $top_dir = canonpath(abs_path(catdir($Bin, updir())));
+ my $lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');
+
+ if (-f catfile($lib_dir, 'CryptFile.pm')) {
+ plan tests => 7;
+ use_ok('Filter::Crypto::CryptFile');
+ }
+ else {
+ plan skip_all => 'CryptFile component not built';
+ }
+}
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+MAIN: {
+ ok(defined &main::crypt_file, 'crypt_file is imported');
+ ok(eval { CRYPT_MODE_AUTO(); 1 }, 'CRYPT_MODE_AUTO is imported');
+ ok(eval { CRYPT_MODE_DECRYPT(); 1 }, 'CRYPT_MODE_DECRYPT is imported');
+ ok(eval { CRYPT_MODE_ENCRYPT(); 1 }, 'CRYPT_MODE_ENCRYPT is imported');
+ ok(eval { CRYPT_MODE_DECRYPTED(); 1 }, 'CRYPT_MODE_DECRYPTED is imported');
+ ok(eval { CRYPT_MODE_ENCRYPTED(); 1 }, 'CRYPT_MODE_ENCRYPTED is imported');
+}
+
+#===============================================================================
@@ -0,0 +1,58 @@
+#!perl
+#===============================================================================
+#
+# t/01_imports_03.t
+#
+# DESCRIPTION
+# Test script to check import options.
+#
+# COPYRIGHT
+# Copyright (C) 2014 Steve Hay. All rights reserved.
+#
+# LICENCE
+# You may distribute under the terms of either the GNU General Public License
+# or the Artistic License, as specified in the LICENCE file.
+#
+#===============================================================================
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Cwd qw(abs_path);
+use File::Spec::Functions qw(canonpath catdir catfile updir);
+use FindBin qw($Bin);
+use Test::More;
+
+#===============================================================================
+# INITIALIZATION
+#===============================================================================
+
+BEGIN {
+ my $top_dir = canonpath(abs_path(catdir($Bin, updir())));
+ my $lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');
+
+ if (-f catfile($lib_dir, 'CryptFile.pm')) {
+ plan tests => 7;
+ use_ok('Filter::Crypto::CryptFile', qw(crypt_file));
+ }
+ else {
+ plan skip_all => 'CryptFile component not built';
+ }
+}
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+MAIN: {
+ ok( defined &main::crypt_file, 'crypt_file is imported');
+ ok(!eval { CRYPT_MODE_AUTO(); 1 }, 'CRYPT_MODE_AUTO is not imported');
+ ok(!eval { CRYPT_MODE_DECRYPT(); 1 }, 'CRYPT_MODE_DECRYPT is not imported');
+ ok(!eval { CRYPT_MODE_ENCRYPT(); 1 }, 'CRYPT_MODE_ENCRYPT is not imported');
+ ok(!eval { CRYPT_MODE_DECRYPTED(); 1 }, 'CRYPT_MODE_DECRYPTED is not imported');
+ ok(!eval { CRYPT_MODE_ENCRYPTED(); 1 }, 'CRYPT_MODE_ENCRYPTED is not imported');
+}
+
+#===============================================================================
@@ -0,0 +1,58 @@
+#!perl
+#===============================================================================
+#
+# t/01_imports_04.t
+#
+# DESCRIPTION
+# Test script to check import options.
+#
+# COPYRIGHT
+# Copyright (C) 2014 Steve Hay. All rights reserved.
+#
+# LICENCE
+# You may distribute under the terms of either the GNU General Public License
+# or the Artistic License, as specified in the LICENCE file.
+#
+#===============================================================================
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Cwd qw(abs_path);
+use File::Spec::Functions qw(canonpath catdir catfile updir);
+use FindBin qw($Bin);
+use Test::More;
+
+#===============================================================================
+# INITIALIZATION
+#===============================================================================
+
+BEGIN {
+ my $top_dir = canonpath(abs_path(catdir($Bin, updir())));
+ my $lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');
+
+ if (-f catfile($lib_dir, 'CryptFile.pm')) {
+ plan tests => 7;
+ use_ok('Filter::Crypto::CryptFile', qw(CRYPT_MODE_AUTO));
+ }
+ else {
+ plan skip_all => 'CryptFile component not built';
+ }
+}
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+MAIN: {
+ ok(!defined &main::crypt_file, 'crypt_file is not imported');
+ ok( eval { CRYPT_MODE_AUTO(); 1 }, 'CRYPT_MODE_AUTO is imported');
+ ok(!eval { CRYPT_MODE_DECRYPT(); 1 }, 'CRYPT_MODE_DECRYPT is not imported');
+ ok(!eval { CRYPT_MODE_ENCRYPT(); 1 }, 'CRYPT_MODE_ENCRYPT is not imported');
+ ok(!eval { CRYPT_MODE_DECRYPTED(); 1 }, 'CRYPT_MODE_DECRYPTED is not imported');
+ ok(!eval { CRYPT_MODE_ENCRYPTED(); 1 }, 'CRYPT_MODE_ENCRYPTED is not imported');
+}
+
+#===============================================================================
@@ -7,7 +7,7 @@
# Test script to check crypt_file() function (and decryption filter).
#
# COPYRIGHT
-# Copyright (C) 2004-2006, 2009 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2006, 2009, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -15,7 +15,7 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -25,6 +25,9 @@ use File::Spec::Functions qw(canonpath catdir catfile updir);
use FindBin qw($Bin);
use Test::More;
+sub new_ifilename();
+sub new_ofilename();
+
#===============================================================================
# INITIALIZATION
#===============================================================================
@@ -32,6 +35,17 @@ use Test::More;
my($have_decrypt);
BEGIN {
+ my $i = 0;
+ sub new_ifilename() {
+ $i++;
+ return "test$i.pl";
+ }
+ my $j = 0;
+ sub new_ofilename() {
+ $j++;
+ return "test$j.enc.pl";
+ }
+
my $top_dir = canonpath(abs_path(catdir($Bin, updir())));
my $lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');
@@ -52,12 +66,6 @@ BEGIN {
#===============================================================================
MAIN: {
- my $fh;
- my $mbfile = 'myblib.pm';
- my $mbname = 'myblib';
- my $ifile = 'test.pl';
- my $ofile = 'test.enc.pl';
- my $iofile = $ifile;
my $script = 'foo.pl';
my $module = 'Foo.pm';
my $str = 'Hello, world.';
@@ -65,554 +73,534 @@ MAIN: {
my $scrsrc = qq[use Carp;\nuse Foo;\nFoo::foo();\n];
my $modsrc = qq[package Foo;\nsub foo() { print "$str\\n" }\n1;\n];
my $head = 'use Filter::Crypto::Decrypt;';
- my $qrhead = qr/^\Q$head\E/;
+ my $qrhead = qr/^\Q$head\E/o;
my $buf = '';
- # Before 5.7.3, -Mblib emitted a "Using ..." message on STDERR, which looks
- # ugly when we spawn a child perl process and breaks the --silent test.
- open $fh, ">$mbfile" or die "Can't create file '$mbfile': $!\n";
- print $fh qq[local \$SIG{__WARN__} = sub { };\neval 'use blib';\n1;\n];
- close $fh;
-
my $perl_exe = $^X =~ / /o ? qq["$^X"] : $^X;
- my $perl = qq[$perl_exe -M$mbname];
+ my $perl = qq[$perl_exe -Mblib];
- my($ifh, $ofh, $iofh, $contents, $saved_contents, $line, $i, $n);
+ my($ifile, $ofile, $iofile);
+ my($fh, $ifh, $ofh, $iofh, $contents, $saved_contents, $line, $i, $n);
- unlink $ifile or die "Can't delete file '$ifile': $!\n" if -e $ifile;
- unlink $ofile or die "Can't delete file '$ofile': $!\n" if -e $ofile;
+ {
+ $ifile = new_ifilename();
+ $iofile = $ifile;
+
+ open $fh, ">$ifile" or die "Can't create file '$ifile': $!\n";
+ print $fh $prog;
+ close $fh;
+
+ open $iofh, "+<$iofile" or die "Can't update file '$iofile': $!\n";
+ binmode $iofh;
+ ok(crypt_file($iofh), 'crypt_file($fh) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $iofh;
- open $fh, ">$ifile" or die "Can't create file '$ifile': $!\n";
- print $fh $prog;
- close $fh;
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted file OK');
- open $iofh, "+<$iofile" or die "Can't update file '$iofile': $!\n";
- binmode $iofh;
- ok(crypt_file($iofh), 'crypt_file($fh) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $iofh;
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file runs OK');
+ }
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted file OK');
+ ok(crypt_file($iofile), 'crypt_file($file) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file runs OK');
- }
+ is($line, $str, '... and decrypted file runs OK');
- ok(crypt_file($iofile), 'crypt_file($file) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
+ open $iofh, "+<$iofile" or die "Can't update file '$iofile': $!\n";
+ binmode $iofh;
+ ok(crypt_file($iofh, CRYPT_MODE_AUTO()),
+ 'crypt_file($fh, CRYPT_MODE_AUTO) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $iofh;
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted file OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted file OK');
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and decrypted file runs OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file runs OK');
+ }
- open $iofh, "+<$iofile" or die "Can't update file '$iofile': $!\n";
- binmode $iofh;
- ok(crypt_file($iofh, CRYPT_MODE_AUTO()),
- 'crypt_file($fh, CRYPT_MODE_AUTO) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $iofh;
+ ok(crypt_file($iofile, CRYPT_MODE_AUTO()),
+ 'crypt_file($file, CRYPT_MODE_AUTO) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted file OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file runs OK');
- }
+ is($line, $str, '... and decrypted file runs OK');
- ok(crypt_file($iofile, CRYPT_MODE_AUTO()),
- 'crypt_file($file, CRYPT_MODE_AUTO) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
+ open $iofh, "+<$iofile" or die "Can't update file '$iofile': $!\n";
+ binmode $iofh;
+ ok(crypt_file($iofh, CRYPT_MODE_ENCRYPT()),
+ 'crypt_file($fh, CRYPT_MODE_ENCRYPT) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $iofh;
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted file OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted file OK');
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and decrypted file runs OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file runs OK');
+ }
- open $iofh, "+<$iofile" or die "Can't update file '$iofile': $!\n";
- binmode $iofh;
- ok(crypt_file($iofh, CRYPT_MODE_ENCRYPT()),
- 'crypt_file($fh, CRYPT_MODE_ENCRYPT) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $iofh;
+ $saved_contents = $contents;
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted file OK');
+ open $iofh, "+<$iofile" or die "Can't update file '$iofile': $!\n";
+ binmode $iofh;
+ ok(crypt_file($iofh, CRYPT_MODE_ENCRYPTED()),
+ 'crypt_file($fh, CRYPT_MODE_ENCRYPTED) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $iofh;
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file runs OK');
- }
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $saved_contents, '... and left file encrypted');
- $saved_contents = $contents;
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file still runs OK');
+ }
- open $iofh, "+<$iofile" or die "Can't update file '$iofile': $!\n";
- binmode $iofh;
- ok(crypt_file($iofh, CRYPT_MODE_ENCRYPTED()),
- 'crypt_file($fh, CRYPT_MODE_ENCRYPTED) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $iofh;
+ ok(crypt_file($iofile, CRYPT_MODE_DECRYPT()),
+ 'crypt_file($file, CRYPT_MODE_DECRYPT) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $saved_contents, '... and left file encrypted');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file still runs OK');
- }
+ is($line, $str, '... and decrypted file runs OK');
- ok(crypt_file($iofile, CRYPT_MODE_DECRYPT()),
- 'crypt_file($file, CRYPT_MODE_DECRYPT) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
-
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted file OK');
-
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and decrypted file runs OK');
-
- ok(crypt_file($iofile, CRYPT_MODE_DECRYPTED()),
- 'crypt_file($file, CRYPT_MODE_DECRYPTED) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
-
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left file decrypted');
-
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and decrypted file still runs OK');
-
- open $ifh, $ifile or die "Can't read file '$ifile': $!\n";
- binmode $ifh;
- open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ifh, $ofh), 'crypt_file($fh1, $fh2) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
- close $ifh;
-
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ ok(crypt_file($iofile, CRYPT_MODE_DECRYPTED()),
+ 'crypt_file($file, CRYPT_MODE_DECRYPTED) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
- unlink $ifile;
-
- open $ofh, $ofile or die "Can't read file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ofh, $ifile), 'crypt_file($fh, $file) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left input file encrypted');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted output file OK');
-
- chomp($line = qx{$perl $ifile});
- is($line, $str, '... and decrypted output file runs OK');
-
- unlink $ofile;
-
- open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ifile, $ofh), 'crypt_file($file, $fh) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left file decrypted');
- unlink $ifile;
-
- ok(crypt_file($ofile, $ifile), 'crypt_file($file1, $file2) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
-
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left input file encrypted');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted output file OK');
-
- chomp($line = qx{$perl $ifile});
- is($line, $str, '... and decrypted output file runs OK');
-
- unlink $ofile;
-
- open $ifh, $ifile or die "Can't read file '$ifile': $!\n";
- binmode $ifh;
- open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ifh, $ofh, CRYPT_MODE_AUTO()),
- 'crypt_file($fh1, $fh2, CRYPT_MODE_AUTO) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
- close $ifh;
-
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and decrypted file still runs OK');
- unlink $ifile;
-
- open $ofh, $ofile or die "Can't read file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ofh, $ifile, CRYPT_MODE_AUTO()),
- 'crypt_file($fh, $file, CRYPT_MODE_AUTO) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left input file encrypted');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted output file OK');
-
- chomp($line = qx{$perl $ifile});
- is($line, $str, '... and decrypted output file runs OK');
-
- unlink $ofile;
-
- open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ifile, $ofh, CRYPT_MODE_AUTO()),
- 'crypt_file($file, $fh, CRYPT_MODE_AUTO) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ $ofile = new_ofilename();
- unlink $ifile;
-
- ok(crypt_file($ofile, $ifile, CRYPT_MODE_AUTO()),
- 'crypt_file($file1, $file2, CRYPT_MODE_AUTO) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left input file encrypted');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted output file OK');
-
- chomp($line = qx{$perl $ifile});
- is($line, $str, '... and decrypted output file runs OK');
-
- unlink $ofile;
-
- open $ifh, $ifile or die "Can't read file '$ifile': $!\n";
- binmode $ifh;
- open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ifh, $ofh, CRYPT_MODE_ENCRYPT()),
- 'crypt_file($fh1, $fh2, CRYPT_MODE_ENCRYPT) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
- close $ifh;
-
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left intput file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ open $ifh, $ifile or die "Can't read file '$ifile': $!\n";
+ binmode $ifh;
+ open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ifh, $ofh), 'crypt_file($fh1, $fh2) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+ close $ifh;
- unlink $ofile;
-
- open $ifh, $ifile or die "Can't read file '$ifile': $!\n";
- binmode $ifh;
- open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ifh, $ofh, CRYPT_MODE_ENCRYPTED()),
- 'crypt_file($fh1, $fh2, CRYPT_MODE_ENCRYPTED) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
- close $ifh;
-
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
- unlink $ifile;
-
- open $ofh, $ofile or die "Can't read file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ofh, $ifile, CRYPT_MODE_DECRYPT()),
- 'crypt_file($fh, $file, CRYPT_MODE_DECRYPT) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left intput file encrypted');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted output file OK');
-
- chomp($line = qx{$perl $ifile});
- is($line, $str, '... and decrypted output file runs OK');
-
- unlink $ifile;
-
- open $ofh, $ofile or die "Can't read file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ofh, $ifile, CRYPT_MODE_DECRYPTED()),
- 'crypt_file($fh, $file, CRYPT_MODE_DECRYPTED) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left input file encrypted');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted output file OK');
-
- chomp($line = qx{$perl $ifile});
- is($line, $str, '... and decrypted output file runs OK');
-
- unlink $ofile;
-
- open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ifile, $ofh, CRYPT_MODE_ENCRYPT()),
- 'crypt_file($file, $fh, CRYPT_MODE_ENCRYPT) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
- unlink $ofile;
-
- open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
- binmode $ofh;
- ok(crypt_file($ifile, $ofh, CRYPT_MODE_ENCRYPTED()),
- 'crypt_file($file, $fh, CRYPT_MODE_ENCRYPTED) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ unlink $ifile;
+ $ifile = new_ifilename();
+
+ open $ofh, $ofile or die "Can't read file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ofh, $ifile), 'crypt_file($fh, $file) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left input file encrypted');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted output file OK');
- unlink $ifile;
-
- ok(crypt_file($ofile, $ifile, CRYPT_MODE_DECRYPT()),
- 'crypt_file($file1, $file2, CRYPT_MODE_DECRYPT) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left input file encrypted');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted output file OK');
-
- chomp($line = qx{$perl $ifile});
- is($line, $str, '... and decrypted output file runs OK');
-
- unlink $ifile;
-
- ok(crypt_file($ofile, $ifile, CRYPT_MODE_DECRYPTED()),
- 'crypt_file($file1, $file2, CRYPT_MODE_DECRYPTED) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
- close $ofh;
-
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left input file encrypted');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted output file OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
chomp($line = qx{$perl $ifile});
is($line, $str, '... and decrypted output file runs OK');
- }
- $prog =~ s/\n$//;
- open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
- print $fh $prog;
- close $fh;
+ unlink $ofile;
+ $ofile = new_ofilename();
- ok(crypt_file($iofile), 'file without newline at EOF: OK') or
- diag("\$ErrStr = '$ErrStr'");
+ open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ifile, $ofh), 'crypt_file($file, $fh) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and file encrypted OK');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file runs OK');
- }
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
- for ($i = 1; $i <= 16; $i++) {
- open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
- binmode $fh;
- print $fh +(';' x ($i - 1)) . "\n";
- close $fh;
+ unlink $ifile;
+ $ifile = new_ifilename();
- ok(crypt_file($iofile), "$i byte file with newline at EOF: OK") or
+ ok(crypt_file($ofile, $ifile), 'crypt_file($file1, $file2) returned OK') or
diag("\$ErrStr = '$ErrStr'");
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
$contents = do { local $/; <$fh> };
close $fh;
- like($contents, $qrhead, '... and file encrypted OK');
+ like($contents, $qrhead, '... and left input file encrypted');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted output file OK');
+
+ chomp($line = qx{$perl $ifile});
+ is($line, $str, '... and decrypted output file runs OK');
+
+ unlink $ofile;
+ $ofile = new_ofilename();
+
+ open $ifh, $ifile or die "Can't read file '$ifile': $!\n";
+ binmode $ifh;
+ open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ifh, $ofh, CRYPT_MODE_AUTO()),
+ 'crypt_file($fh1, $fh2, CRYPT_MODE_AUTO) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+ close $ifh;
+
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
SKIP: {
skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, '', '... and encrypted file runs OK');
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $ifile;
+ $ifile = new_ifilename();
+
+ open $ofh, $ofile or die "Can't read file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ofh, $ifile, CRYPT_MODE_AUTO()),
+ 'crypt_file($fh, $file, CRYPT_MODE_AUTO) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left input file encrypted');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted output file OK');
+
+ chomp($line = qx{$perl $ifile});
+ is($line, $str, '... and decrypted output file runs OK');
+
+ unlink $ofile;
+ $ofile = new_ofilename();
+
+ open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ifile, $ofh, CRYPT_MODE_AUTO()),
+ 'crypt_file($file, $fh, CRYPT_MODE_AUTO) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $ifile;
+ $ifile = new_ifilename();
+
+ ok(crypt_file($ofile, $ifile, CRYPT_MODE_AUTO()),
+ 'crypt_file($file1, $file2, CRYPT_MODE_AUTO) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left input file encrypted');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted output file OK');
+
+ chomp($line = qx{$perl $ifile});
+ is($line, $str, '... and decrypted output file runs OK');
+
+ unlink $ofile;
+ $ofile = new_ofilename();
+
+ open $ifh, $ifile or die "Can't read file '$ifile': $!\n";
+ binmode $ifh;
+ open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ifh, $ofh, CRYPT_MODE_ENCRYPT()),
+ 'crypt_file($fh1, $fh2, CRYPT_MODE_ENCRYPT) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+ close $ifh;
+
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left intput file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
}
+
+ unlink $ofile;
+ $ofile = new_ofilename();
+
+ open $ifh, $ifile or die "Can't read file '$ifile': $!\n";
+ binmode $ifh;
+ open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ifh, $ofh, CRYPT_MODE_ENCRYPTED()),
+ 'crypt_file($fh1, $fh2, CRYPT_MODE_ENCRYPTED) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+ close $ifh;
+
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $ifile;
+ $ifile = new_ifilename();
+
+ open $ofh, $ofile or die "Can't read file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ofh, $ifile, CRYPT_MODE_DECRYPT()),
+ 'crypt_file($fh, $file, CRYPT_MODE_DECRYPT) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left intput file encrypted');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted output file OK');
+
+ chomp($line = qx{$perl $ifile});
+ is($line, $str, '... and decrypted output file runs OK');
+
+ unlink $ifile;
+ $ifile = new_ifilename();
+
+ open $ofh, $ofile or die "Can't read file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ofh, $ifile, CRYPT_MODE_DECRYPTED()),
+ 'crypt_file($fh, $file, CRYPT_MODE_DECRYPTED) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left input file encrypted');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted output file OK');
+
+ chomp($line = qx{$perl $ifile});
+ is($line, $str, '... and decrypted output file runs OK');
+
+ unlink $ofile;
+ $ofile = new_ofilename();
+
+ open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ifile, $ofh, CRYPT_MODE_ENCRYPT()),
+ 'crypt_file($file, $fh, CRYPT_MODE_ENCRYPT) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $ofile;
+ $ofile = new_ofilename();
+
+ open $ofh, ">$ofile" or die "Can't write file '$ofile': $!\n";
+ binmode $ofh;
+ ok(crypt_file($ifile, $ofh, CRYPT_MODE_ENCRYPTED()),
+ 'crypt_file($file, $fh, CRYPT_MODE_ENCRYPTED) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $ifile;
+ $ifile = new_ifilename();
+
+ ok(crypt_file($ofile, $ifile, CRYPT_MODE_DECRYPT()),
+ 'crypt_file($file1, $file2, CRYPT_MODE_DECRYPT) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left input file encrypted');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted output file OK');
+
+ chomp($line = qx{$perl $ifile});
+ is($line, $str, '... and decrypted output file runs OK');
+
+ unlink $ifile;
+ $ifile = new_ifilename();
+
+ ok(crypt_file($ofile, $ifile, CRYPT_MODE_DECRYPTED()),
+ 'crypt_file($file1, $file2, CRYPT_MODE_DECRYPTED) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
+ close $ofh;
+
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left input file encrypted');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ifile});
+ is($line, $str, '... and decrypted output file runs OK');
+ }
+
+ unlink $ifile;
+ unlink $ofile;
}
- for ($i = 1; $i <= 16; $i++) {
+ {
+ $iofile = new_ifilename();
+
+ $prog =~ s/\n$//o;
open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
- print $fh ';' x $i;
+ print $fh $prog;
close $fh;
- ok(crypt_file($iofile), "$i byte file without newline at EOF: OK") or
- diag("\$ErrStr = '$ErrStr'");
+ ok(crypt_file($iofile), 'file without newline at EOF: OK') or
+ diag("\$ErrStr = '$ErrStr'");
open $fh, $iofile or die "Can't read file '$iofile': $!\n";
$contents = do { local $/; <$fh> };
@@ -622,12 +610,95 @@ MAIN: {
SKIP: {
skip 'Decrypt component not built', 1 unless $have_decrypt;
chomp($line = qx{$perl $iofile});
- is($line, '', '... and encrypted file runs OK');
+ is($line, $str, '... and encrypted file runs OK');
}
- }
- for ($i = 1; $i <= 16; $i++) {
- $buf = ';' x $i;
+ for ($i = 1; $i <= 16; $i++) {
+ open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
+ binmode $fh;
+ print $fh +(';' x ($i - 1)) . "\n";
+ close $fh;
+
+ ok(crypt_file($iofile), "$i byte file with newline at EOF: OK") or
+ diag("\$ErrStr = '$ErrStr'");
+
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and file encrypted OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, '', '... and encrypted file runs OK');
+ }
+ }
+
+ for ($i = 1; $i <= 16; $i++) {
+ open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
+ print $fh ';' x $i;
+ close $fh;
+
+ ok(crypt_file($iofile), "$i byte file without newline at EOF: OK") or
+ diag("\$ErrStr = '$ErrStr'");
+
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and file encrypted OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, '', '... and encrypted file runs OK');
+ }
+ }
+
+ for ($i = 1; $i <= 16; $i++) {
+ $buf = ';' x $i;
+ open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
+ print $fh qq[print "$buf";\n];
+ close $fh;
+
+ $n = -s $iofile;
+ ok(crypt_file($iofile), "$n byte file with newline at EOF: OK") or
+ diag("\$ErrStr = '$ErrStr'");
+
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and file encrypted OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $buf, '... and encrypted file runs OK');
+ }
+ }
+
+ for ($i = 1; $i <= 16; $i++) {
+ $buf = ';' x $i;
+ open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
+ print $fh qq[print "$buf";];
+ close $fh;
+
+ $n = -s $iofile;
+ ok(crypt_file($iofile), "$n byte file without newline at EOF: OK") or
+ diag("\$ErrStr = '$ErrStr'");
+
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and file encrypted OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $buf, '... and encrypted file runs OK');
+ }
+ }
+
+ $buf = ';' x 4096;
open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
print $fh qq[print "$buf";\n];
close $fh;
@@ -646,10 +717,8 @@ MAIN: {
chomp($line = qx{$perl $iofile});
is($line, $buf, '... and encrypted file runs OK');
}
- }
- for ($i = 1; $i <= 16; $i++) {
- $buf = ';' x $i;
+ $buf = ';' x 4096;
open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
print $fh qq[print "$buf";];
close $fh;
@@ -668,93 +737,54 @@ MAIN: {
chomp($line = qx{$perl $iofile});
is($line, $buf, '... and encrypted file runs OK');
}
- }
-
- $buf = ';' x 4096;
- open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
- print $fh qq[print "$buf";\n];
- close $fh;
-
- $n = -s $iofile;
- ok(crypt_file($iofile), "$n byte file with newline at EOF: OK") or
- diag("\$ErrStr = '$ErrStr'");
-
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and file encrypted OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, $buf, '... and encrypted file runs OK');
- }
-
- $buf = ';' x 4096;
- open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
- print $fh qq[print "$buf";];
- close $fh;
-
- $n = -s $iofile;
- ok(crypt_file($iofile), "$n byte file without newline at EOF: OK") or
- diag("\$ErrStr = '$ErrStr'");
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and file encrypted OK');
-
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, $buf, '... and encrypted file runs OK');
- }
-
- open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
- print $fh $prog;
- close $fh;
+ open $fh, ">$iofile" or die "Can't create file '$iofile': $!\n";
+ print $fh $prog;
+ close $fh;
- ok(crypt_file($iofile), 'crypt_file($file) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
+ ok(crypt_file($iofile), 'crypt_file($file) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and file encrypted OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and file encrypted OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl -MCarp $iofile});
- is($line, $str, '... and encrypted file runs OK with Carp loaded');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl -MCarp $iofile});
+ is($line, $str, '... and encrypted file runs OK with Carp loaded');
+ }
+
+ unlink $iofile;
}
- open $fh, ">$script" or die "Can't create file '$script': $!\n";
- print $fh $scrsrc;
- close $fh;
+ {
+ open $fh, ">$script" or die "Can't create file '$script': $!\n";
+ print $fh $scrsrc;
+ close $fh;
- open $fh, ">$module" or die "Can't create file '$module': $!\n";
- print $fh $modsrc;
- close $fh;
+ open $fh, ">$module" or die "Can't create file '$module': $!\n";
+ print $fh $modsrc;
+ close $fh;
- ok(crypt_file($module), 'crypt_file($file) returned OK') or
- diag("\$ErrStr = '$ErrStr'");
+ ok(crypt_file($module), 'crypt_file($file) returned OK') or
+ diag("\$ErrStr = '$ErrStr'");
- open $fh, $module or die "Can't read file '$module': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and module encrypted OK');
+ open $fh, $module or die "Can't read file '$module': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and module encrypted OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $script});
- is($line, $str, '... and encrypted module runs OK with Carp loaded');
- }
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $script});
+ is($line, $str, '... and encrypted module runs OK with Carp loaded');
+ }
- unlink $mbfile;
- unlink $ifile;
- unlink $ofile;
- unlink $script;
- unlink $module;
+ unlink $script;
+ unlink $module;
+ }
}
#===============================================================================
@@ -7,7 +7,7 @@
# Test script to check crypt_file script (and decryption filter).
#
# COPYRIGHT
-# Copyright (C) 2004-2007, 2009 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2007, 2009, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -15,7 +15,7 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -23,9 +23,12 @@ use warnings;
use Cwd qw(abs_path cwd);
use File::Copy qw(copy);
use File::Spec::Functions qw(canonpath catdir catfile devnull rel2abs updir);
+use File::Temp qw(tempfile);
use FindBin qw($Bin);
use Test::More;
+sub new_ofilename();
+
#===============================================================================
# INITIALIZATION
#===============================================================================
@@ -33,23 +36,17 @@ use Test::More;
my($top_dir, $lib_dir);
BEGIN {
- if ($] < 5.006001) {
- # Before 5.6.1, Cwd::abs_path() did not correctly clean-up Win32 paths
- # like C:\Temp\.., which breaks the -d/-r/-t tests, so do it the hard
- # way instead. Do it for all OSes just in case.
- my $cwd = cwd();
- chdir $Bin or die "Can't cd to test script directory: $!\n";
- chdir updir() or die "Can't cd to parent directory: $!\n";
- $top_dir = canonpath(cwd());
- chdir $cwd or die "Can't cd to original directory: $!\n";
- }
- else {
- $top_dir = canonpath(abs_path(catdir($Bin, updir())));
+ my $i = 0;
+ sub new_ofilename() {
+ $i++;
+ return "test$i.enc.pl";
}
+
+ $top_dir = canonpath(abs_path(catdir($Bin, updir())));
$lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');
if (-f catfile($lib_dir, 'CryptFile.pm')) {
- plan tests => 99;
+ plan tests => 105;
}
else {
plan skip_all => 'CryptFile component not built';
@@ -61,11 +58,7 @@ BEGIN {
#===============================================================================
MAIN: {
- my $fh;
- my $mbfile = 'myblib.pm';
- my $mbname = 'myblib';
my $ifile = 'test.pl';
- my $ofile = 'test.enc.pl';
my $iofile = $ifile;
my $script = 'foo.pl';
my $module = 'Foo.pm';
@@ -79,33 +72,23 @@ MAIN: {
my $scrsrc = qq[use Foo;\nFoo::foo();\n];
my $modsrc = qq[package Foo;\nsub foo() { print "$str\\n" }\n1;\n];
my $head = 'use Filter::Crypto::Decrypt;';
- my $qrhead = qr/^\Q$head\E/;
- my $q = $^O =~ /MSWin32/io ? '' : "'";
+ my $qrhead = qr/^\Q$head\E/o;
+ my $q = $^O eq 'MSWin32' ? '' : "'";
my $null = devnull();
- # Before 5.7.3, -Mblib emitted a "Using ..." message on STDERR, which looks
- # ugly when we spawn a child perl process and breaks the --silent test.
- open $fh, ">$mbfile" or die "Can't create file '$mbfile': $!\n";
- print $fh qq[local \$SIG{__WARN__} = sub { };\neval 'use blib';\n1;\n];
- close $fh;
-
my $perl_exe = $^X =~ / /o ? qq["$^X"] : $^X;
- my $perl = qq[$perl_exe -M$mbname];
+ my $perl = qq[$perl_exe -Mblib];
my $have_decrypt = -f catfile($lib_dir, 'Decrypt.pm');
- my $have_file_temp = eval { require File::Temp; 1 };
my $crypt_file = catfile($top_dir, 'blib', 'script', 'crypt_file');
require Filter::Crypto::CryptFile;
my $debug_mode = Filter::Crypto::CryptFile::_debug_mode();
- my($contents, $line, $dfile, $rdir, $abs_ifile, $cdir, $ddir);
+ my($fh, $ofile, $contents, $line, $dfile, $rdir, $abs_ifile, $cdir, $ddir);
my($dir3, $dir4, $dir5, $expected, $file, $data);
- unlink $ifile or die "Can't delete file '$ifile': $!\n" if -e $ifile;
- unlink $ofile or die "Can't delete file '$ofile': $!\n" if -e $ofile;
-
open $fh, ">$ifile" or die "Can't create file '$ifile': $!\n";
print $fh $prog;
close $fh;
@@ -126,341 +109,383 @@ MAIN: {
print $fh "binmode STDIN; binmode STDOUT; print while <>;\n";
close $fh;
- qx{$perl $crypt_file <$ifile >$ofile 2>$null};
- is($?, 0, 'crypt_file ran OK when using STD handle re-directions');
+ {
+ $ofile = new_ofilename();
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
+ qx{$perl $crypt_file <$ifile >$ofile 2>$null};
+ is($?, 0, 'crypt_file ran OK when using STD handle re-directions');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $ofile;
}
- unlink $ofile;
+ {
+ $ofile = new_ofilename();
- # Explicitly terminate crypt_file's (empty) options list with a "--" since
- # Getopt::Long's handling of a lone "-" is broken before version 2.25, which
- # was first distributed in Perl 5.6.1.
- qx{$perl $cat <$ifile | $perl $crypt_file -- - 2>$null | $perl $cat >$ofile};
- is($?, 0, 'crypt_file ran OK when using STD handle pipelines');
+ qx{$perl $cat <$ifile | $perl $crypt_file - 2>$null | $perl $cat >$ofile};
+ is($?, 0, 'crypt_file ran OK when using STD handle pipelines');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
+ unlink $ofile;
+ unlink $cat;
}
- unlink $ofile;
+ {
+ $ofile = new_ofilename();
- qx{$perl $crypt_file $ifile >$ofile 2>$null};
- is($?, 0, 'crypt_file ran OK with file spec input');
+ qx{$perl $crypt_file $ifile >$ofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with file spec input');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
+ unlink $ofile;
}
- unlink $ofile;
+ {
+ $ofile = new_ofilename();
- qx{$perl $crypt_file -l $lfile >$ofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -l option');
+ qx{$perl $crypt_file -l $lfile >$ofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -l option');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $ofile;
+ unlink $lfile;
}
- unlink $ofile;
+ {
+ $ofile = new_ofilename();
- mkdir $dir1 or die "Can't create directory '$dir1': $!\n";
- copy($ifile, $dir1) or
- die "Can't copy file '$ifile' into directory '$dir1': $!\n";
+ mkdir $dir1 or die "Can't create directory '$dir1': $!\n";
+ copy($ifile, $dir1) or
+ die "Can't copy file '$ifile' into directory '$dir1': $!\n";
- qx{$perl $crypt_file -d $dir1 $ifile >$ofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -d option');
+ qx{$perl $crypt_file -d $dir1 $ifile >$ofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -d option');
- $dfile = catfile($dir1, $ifile);
- open $fh, $dfile or die "Can't read file '$dfile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
+ $dfile = catfile($dir1, $ifile);
+ open $fh, $dfile or die "Can't read file '$dfile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $dfile;
+ unlink $ofile;
}
- unlink $dfile;
- unlink $ofile;
+ {
+ $ofile = new_ofilename();
- $rdir = catdir($dir1, $dir2);
- mkdir $rdir or die "Can't create directory '$rdir': $!\n";
- copy($ifile, $rdir) or
- die "Can't copy file '$ifile' into directory '$rdir': $!\n";
+ $rdir = catdir($dir1, $dir2);
+ mkdir $rdir or die "Can't create directory '$rdir': $!\n";
+ copy($ifile, $rdir) or
+ die "Can't copy file '$ifile' into directory '$rdir': $!\n";
- qx[$perl $crypt_file -d $dir1 -r ${q}test.p?$q >$ofile 2>$null];
- is($?, 0, 'crypt_file ran OK with -r option');
+ qx[$perl $crypt_file -d $dir1 -r ${q}test.p?$q >$ofile 2>$null];
+ is($?, 0, 'crypt_file ran OK with -r option');
- $dfile = catfile($rdir, $ifile);
- open $fh, $dfile or die "Can't read file '$dfile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
+ $dfile = catfile($rdir, $ifile);
+ open $fh, $dfile or die "Can't read file '$dfile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
+ unlink $dfile;
+ rmdir $rdir;
+ rmdir $dir1;
+ unlink $ofile;
}
- unlink $dfile;
- rmdir $rdir;
- rmdir $dir1;
- unlink $ofile;
+ {
+ $abs_ifile = rel2abs($ifile);
+ chomp($data = qx{$perl $crypt_file -t $ifile});
+ is($?, 0, 'crypt_file ran OK with -t option');
+ is($data, $abs_ifile, '... and output correct file path');
- $abs_ifile = rel2abs($ifile);
- chomp($data = qx{$perl $crypt_file -t $ifile});
- is($?, 0, 'crypt_file ran OK with -t option');
- is($data, $abs_ifile, '... and output correct file path');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ }
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
-
- $dir3 = catdir($top_dir, 'lib');
- $dir4 = catdir($dir3, 'Filter');
- $dir5 = catdir($dir3, 'PAR', 'Filter');
-
- $expected = catdir($dir4, 'Crypto.pm');
- $file = catfile('lib', 'Filter', 'Crypto.pm');
- chomp($data = qx{$perl $crypt_file -d $top_dir -t $file});
- is($data, $expected, '-t works with one -d');
- $file = catfile('Filter', 'Crypto.pm');
- chomp($data = qx{$perl $crypt_file -d $dir3 -t $file});
- is($data, $expected, '-t works with another -d');
- $file = 'Crypto.pm';
- chomp($data = qx{$perl $crypt_file -d $dir4 -t $file});
- is($data, $expected, '-t works with yet another -d');
-
- $expected = catdir($dir4, $file);
- chomp($data = qx{$perl $crypt_file -d $dir4 -d $dir5 -t $file});
- is($data, $expected, "-t works with two -ds");
-
- $expected = catdir($dir5, $file);
- chomp($data = qx{$perl $crypt_file -d $dir5 -d $dir4 -t $file});
- is($data, $expected, "-t works with two -ds reversed");
-
- $expected = catfile($top_dir, 'Makefile.PL') . "\n";
- $data = qx[$perl $crypt_file -d $top_dir -t ${q}Makefil?.PL$q];
- is($data, $expected, '-t works with -d and a glob');
- $data = qx[$perl $crypt_file -d $top_dir -t ${q}Make*.PL$q];
- is($data, $expected, '-t works with -d and another glob');
- $data = qx[$perl $crypt_file -d $top_dir -t ${q}Makefile.[PQR]L$q];
- is($data, $expected, '-t works with -d and yet another glob');
-
- $expected = join("\n", sort +(
- catfile($top_dir, 'Makefile.PL'),
- catfile($top_dir, 'CryptFile', 'Makefile.PL'),
- catfile($top_dir, 'Decrypt', 'Makefile.PL')
- )) . "\n";
- chomp($data = qx[$perl $crypt_file -d $top_dir -r -t ${q}Makefil?.PL$q]);
- $data = join("\n", sort split /\n/, $data) . "\n";
- is($data, $expected, '-t works with -d, -r and a glob');
- chomp($data = qx[$perl $crypt_file -d $top_dir -r -t ${q}Make*.PL$q]);
- $data = join("\n", sort split /\n/, $data) . "\n";
- is($data, $expected, '-t works with -d, -r and another glob');
- chomp($data = qx[$perl $crypt_file -d $top_dir -r -t ${q}Makefile.[PQR]L$q]);
- $data = join("\n", sort split /\n/, $data) . "\n";
- is($data, $expected, '-t works with -d, -r and yet another glob');
-
- $dir3 = catdir($top_dir, 'CryptFile');
- $dir4 = catdir($top_dir, 'Decrypt');
- $file = "${q}Make*.PL$q";
-
- chomp($data = qx{$perl $crypt_file -d $top_dir -d $dir3 -d $dir4 -t $file});
- $data = join("\n", sort split /\n/, $data) . "\n";
- is($data, $expected, "-t works with three -ds and a glob");
- chomp($data = qx{$perl $crypt_file -d $top_dir -d $dir3 -d $dir4 -r -t $file});
- $data = join("\n", sort split /\n/, $data) . "\n";
- is($data, $expected, "-t works with three -ds, -r and a glob");
-
- chomp($line = qx{$perl $crypt_file $ifile 2>&1 1>$ofile});
- is($?, 0, 'crypt_file ran OK without --silent option');
- SKIP: {
- skip 'Built in debug mode', 1 if $debug_mode;
- is($line, "$abs_ifile: OK", '... and output correct file path');
+ {
+ $dir3 = catdir($top_dir, 'lib');
+ $dir4 = catdir($dir3, 'Filter');
+ $dir5 = catdir($dir3, 'PAR', 'Filter');
+
+ $expected = catdir($dir4, 'Crypto.pm');
+ $file = catfile('lib', 'Filter', 'Crypto.pm');
+ chomp($data = qx{$perl $crypt_file -d $top_dir -t $file});
+ is($data, $expected, '-t works with one -d');
+ $file = catfile('Filter', 'Crypto.pm');
+ chomp($data = qx{$perl $crypt_file -d $dir3 -t $file});
+ is($data, $expected, '-t works with another -d');
+ $file = 'Crypto.pm';
+ chomp($data = qx{$perl $crypt_file -d $dir4 -t $file});
+ is($data, $expected, '-t works with yet another -d');
+
+ $expected = catdir($dir4, $file);
+ chomp($data = qx{$perl $crypt_file -d $dir4 -d $dir5 -t $file});
+ is($data, $expected, "-t works with two -ds");
+
+ $expected = catdir($dir5, $file);
+ chomp($data = qx{$perl $crypt_file -d $dir5 -d $dir4 -t $file});
+ is($data, $expected, "-t works with two -ds reversed");
+
+ $expected = catfile($top_dir, 'Makefile.PL') . "\n";
+ $data = qx[$perl $crypt_file -d $top_dir -t ${q}Makefil?.PL$q];
+ is($data, $expected, '-t works with -d and a glob');
+ $data = qx[$perl $crypt_file -d $top_dir -t ${q}Make*.PL$q];
+ is($data, $expected, '-t works with -d and another glob');
+ $data = qx[$perl $crypt_file -d $top_dir -t ${q}Makefile.[PQR]L$q];
+ is($data, $expected, '-t works with -d and yet another glob');
+
+ $expected = join("\n", sort +(
+ catfile($top_dir, 'Makefile.PL'),
+ catfile($top_dir, 'CryptFile', 'Makefile.PL'),
+ catfile($top_dir, 'Decrypt', 'Makefile.PL')
+ )) . "\n";
+ chomp($data = qx[$perl $crypt_file -d $top_dir -r -t ${q}Makefil?.PL$q]);
+ $data = join("\n", sort split /\n/, $data) . "\n";
+ is($data, $expected, '-t works with -d, -r and a glob');
+ chomp($data = qx[$perl $crypt_file -d $top_dir -r -t ${q}Make*.PL$q]);
+ $data = join("\n", sort split /\n/, $data) . "\n";
+ is($data, $expected, '-t works with -d, -r and another glob');
+ chomp($data = qx[$perl $crypt_file -d $top_dir -r -t ${q}Makefile.[PQR]L$q]);
+ $data = join("\n", sort split /\n/, $data) . "\n";
+ is($data, $expected, '-t works with -d, -r and yet another glob');
+
+ $dir3 = catdir($top_dir, 'CryptFile');
+ $dir4 = catdir($top_dir, 'Decrypt');
+ $file = "${q}Make*.PL$q";
+
+ chomp($data = qx{$perl $crypt_file -d $top_dir -d $dir3 -d $dir4 -t $file});
+ $data = join("\n", sort split /\n/, $data) . "\n";
+ is($data, $expected, "-t works with three -ds and a glob");
+ chomp($data = qx{$perl $crypt_file -d $top_dir -d $dir3 -d $dir4 -r -t $file});
+ $data = join("\n", sort split /\n/, $data) . "\n";
+ is($data, $expected, "-t works with three -ds, -r and a glob");
}
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
+ {
+ $ofile = new_ofilename();
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
- }
+ chomp($line = qx{$perl $crypt_file $ifile 2>&1 1>$ofile});
+ is($?, 0, 'crypt_file ran OK without --silent option');
+ SKIP: {
+ skip 'Built in debug mode', 1 if $debug_mode;
+ is($line, "$abs_ifile: OK", '... and output correct file path');
+ }
- chomp($line = qx{$perl $crypt_file --silent $ifile 2>&1 1>$ofile});
- is($?, 0, 'crypt_file ran OK with --silent option');
- SKIP: {
- skip 'Built in debug mode', 1 if $debug_mode;
- is($line, '', "... and didn't output a file path");
- }
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted output file OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
+ unlink $ofile;
}
- unlink $ofile;
+ {
+ $ofile = new_ofilename();
- qx{$perl $crypt_file -i $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -i option');
+ chomp($line = qx{$perl $crypt_file --silent $ifile 2>&1 1>$ofile});
+ is($?, 0, 'crypt_file ran OK with --silent option');
+ SKIP: {
+ skip 'Built in debug mode', 1 if $debug_mode;
+ is($line, '', "... and didn't output a file path");
+ }
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted input file OK');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted output file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted input file runs OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
+
+ unlink $ofile;
}
- qx{$perl $crypt_file -i $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK again with -i option');
+ {
+ qx{$perl $crypt_file -i $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -i option');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted input file OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted input file OK');
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and decrypted input file runs OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted input file runs OK');
+ }
- qx{$perl $crypt_file -i $script 2>$null};
- is($?, 0, 'crypt_file ran OK with unencrypted script + module');
+ qx{$perl $crypt_file -i $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK again with -i option');
- open $fh, $script or die "Can't read file '$script': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted script OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted input file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $script});
- is($line, $str, '... and encrypted script + unencrypted module run OK');
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and decrypted input file runs OK');
}
- qx{$perl $crypt_file -i $module 2>$null};
- is($?, 0, 'crypt_file ran OK with unencrypted module');
+ {
+ qx{$perl $crypt_file -i $script 2>$null};
+ is($?, 0, 'crypt_file ran OK with unencrypted script + module');
- open $fh, $module or die "Can't read file '$module': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted module OK');
+ open $fh, $script or die "Can't read file '$script': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted script OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $script});
- is($line, $str, '... and encrypted script + encrypted module run OK');
- }
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $script});
+ is($line, $str, '... and encrypted script + unencrypted module run OK');
+ }
- qx{$perl $crypt_file -i $script 2>$null};
- is($?, 0, 'crypt_file ran OK with encrypted script + module');
+ qx{$perl $crypt_file -i $module 2>$null};
+ is($?, 0, 'crypt_file ran OK with unencrypted module');
- open $fh, $script or die "Can't read file '$script': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $scrsrc, '... and decrypted script OK');
+ open $fh, $module or die "Can't read file '$module': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted module OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $script});
- is($line, $str, '... and unencrypted script + encrypted module run OK');
- }
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $script});
+ is($line, $str, '... and encrypted script + encrypted module run OK');
+ }
- qx{$perl $crypt_file -i -e memory $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -e memory option');
+ qx{$perl $crypt_file -i $script 2>$null};
+ is($?, 0, 'crypt_file ran OK with encrypted script + module');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted file OK');
+ open $fh, $script or die "Can't read file '$script': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $scrsrc, '... and decrypted script OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file runs OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $script});
+ is($line, $str, '... and unencrypted script + encrypted module run OK');
+ }
+
+ unlink $script;
+ unlink $module;
}
- SKIP: {
- skip 'File::Temp required to test -e tempfile', 2
- unless $have_file_temp;
+ {
+ qx{$perl $crypt_file -i -e memory $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -e memory option');
+
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file runs OK');
+ }
+
qx{$perl $crypt_file -i -e tempfile $iofile 2>$null};
is($?, 0, 'crypt_file ran OK with -e tempfile option');
@@ -470,174 +495,196 @@ MAIN: {
is($contents, $prog, '... and decrypted file OK');
}
- unless ($have_file_temp) {
- open $fh, ">$iofile" or die "Can't recreate file '$iofile': $!\n";
- print $fh $prog;
- close $fh;
- }
+ {
+ qx{$perl $crypt_file -i -b $q*.bak$q $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -b option');
- qx{$perl $crypt_file -i -b $q*.bak$q $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -b option');
+ open $fh, $bfile or die "Can't read file '$bfile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and created unencrypted backup file');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted file OK');
- open $fh, $bfile or die "Can't read file '$bfile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and created unencrypted backup file');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted file OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file runs OK');
+ }
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file runs OK');
+ rename $bfile, $iofile;
}
- unlink $iofile;
- rename $bfile, $iofile;
+ {
+ ($ofile = $ifile) =~ s/\.(.*?)$/.enc.$1/;
- qx{$perl $crypt_file -o $q?.enc.[$q $ifile 2>$null};
- is($?, 0, 'crypt_file ran OK with -o option');
+ qx{$perl $crypt_file -o $q?.enc.[$q $ifile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -o option');
- open $fh, $ifile or die "Can't read file '$ifile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left input file unencrypted');
- open $fh, $ofile or die "Can't read file '$ofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and created encrypted output file OK');
+ open $fh, $ifile or die "Can't read file '$ifile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left input file unencrypted');
+ open $fh, $ofile or die "Can't read file '$ofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and created encrypted output file OK');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $ofile});
+ is($line, $str, '... and encrypted output file runs OK');
+ }
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $ofile});
- is($line, $str, '... and encrypted output file runs OK');
+ unlink $ofile;
}
- unlink $ofile;
+ {
+ qx{$perl $crypt_file -i -c auto $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -c auto option');
- qx{$perl $crypt_file -i -c auto $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -c auto option');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted file OK');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted file OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file runs OK');
+ }
+
+ qx{$perl $crypt_file -i -c auto $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK again with -c auto option');
+
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file runs OK');
- }
+ is($line, $str, '... and decrypted file runs OK');
- qx{$perl $crypt_file -i -c auto $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK again with -c auto option');
+ qx{$perl $crypt_file -i -c encrypt $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -c encrypt option');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted file OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and encrypted file OK');
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and decrypted file runs OK');
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file runs OK');
+ }
- qx{$perl $crypt_file -i -c encrypt $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -c encrypt option');
+ qx{$perl $crypt_file -i -c encrypted $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -c encrypted option (working in memory)');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and encrypted file OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left file encrypted');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file runs OK');
- }
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file still runs OK');
+ }
- qx{$perl $crypt_file -i -c encrypted $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -c encrypted option');
+ qx{$perl $crypt_file -i -e tempfile -c encrypted $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -c encrypted option (using a tempfile)');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- like($contents, $qrhead, '... and left file encrypted');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ like($contents, $qrhead, '... and left file encrypted');
+
+ SKIP: {
+ skip 'Decrypt component not built', 1 unless $have_decrypt;
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and encrypted file still runs OK');
+ }
+
+ qx{$perl $crypt_file -i -c decrypt $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -c decrypt option');
+
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and decrypted file OK');
- SKIP: {
- skip 'Decrypt component not built', 1 unless $have_decrypt;
chomp($line = qx{$perl $iofile});
- is($line, $str, '... and encrypted file still runs OK');
- }
+ is($line, $str, '... and decrypted file runs OK');
- qx{$perl $crypt_file -i -c decrypt $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -c decrypt');
+ qx{$perl $crypt_file -i -c decrypted $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -c decrypted option (working in memory)');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and decrypted file OK');
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left file decrypted');
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and decrypted file runs OK');
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and decrypted file still runs OK');
- qx{$perl $crypt_file -i -c decrypted $iofile 2>$null};
- is($?, 0, 'crypt_file ran OK with -c decrypted');
+ qx{$perl $crypt_file -i -e tempfile -c decrypted $iofile 2>$null};
+ is($?, 0, 'crypt_file ran OK with -c decrypted option (using a tempfile)');
- open $fh, $iofile or die "Can't read file '$iofile': $!\n";
- $contents = do { local $/; <$fh> };
- close $fh;
- is($contents, $prog, '... and left file decrypted');
-
- chomp($line = qx{$perl $iofile});
- is($line, $str, '... and decrypted file still runs OK');
-
- chomp($data = qx{$perl $crypt_file -v});
- like($data, qr/\A This\ is\ crypt_file .*?
- ^ Copyright .*?
- ^ This\ script\ is\ free\ software /mosx,
- '-v option works');
-
- chomp($data = qx{$perl $crypt_file -h});
- like($data, qr/\A Usage: .*?
- ^ Arguments: .*?
- ^ Options: /mosx,
- '-h option works');
-
- SKIP: {
- if (-e catfile('', 'etc', 'debian_version') and
- not -e catfile('', 'usr', 'bin', 'perldoc.stub'))
- {
- skip 'Debian-based host without perl-doc installed', 1;
- }
+ open $fh, $iofile or die "Can't read file '$iofile': $!\n";
+ $contents = do { local $/; <$fh> };
+ close $fh;
+ is($contents, $prog, '... and left file decrypted');
+
+ chomp($line = qx{$perl $iofile});
+ is($line, $str, '... and decrypted file still runs OK');
- local $ENV{PERLDOC} = '-t';
- chomp($data = qx{$perl $crypt_file -m});
- like($data, qr/^ NAME .*?
- ^ SYNOPSIS .*?
- ^ ARGUMENTS .*?
- ^ OPTIONS .*?
- ^ EXIT\ STATUS .*?
- ^ DIAGNOSTICS .*?
- ^ EXAMPLES .*?
- ^ ENVIRONMENT .*?
- ^ SEE\ ALSO .*?
- ^ AUTHOR .*?
- ^ COPYRIGHT .*?
- ^ LICENCE .*?
- ^ VERSION .*?
- ^ DATE .*?
- ^ HISTORY /mosx,
- '-m option works');
+ unlink $iofile;
}
- unlink $mbfile;
- unlink $ifile;
- unlink $ofile;
- unlink $lfile;
- unlink $script;
- unlink $module;
- unlink $cat;
+ {
+ chomp($data = qx{$perl $crypt_file -v});
+ like($data, qr/\A This\ is\ crypt_file .*?
+ ^ Copyright .*?
+ ^ This\ script\ is\ free\ software /mosx,
+ '-v option works');
+
+ chomp($data = qx{$perl $crypt_file -h});
+ like($data, qr/\A Usage: .*?
+ ^ Arguments: .*?
+ ^ Options: /mosx,
+ '-h option works');
+
+ SKIP: {
+ if (-e catfile('', 'etc', 'debian_version') and
+ not -e catfile('', 'usr', 'bin', 'perldoc.stub'))
+ {
+ skip 'Debian-based host without perl-doc installed', 1;
+ }
+
+ local $ENV{PERLDOC} = '-t';
+ chomp($data = qx{$perl $crypt_file -m});
+ like($data, qr/^ NAME .*?
+ ^ SYNOPSIS .*?
+ ^ ARGUMENTS .*?
+ ^ OPTIONS .*?
+ ^ EXIT\ STATUS .*?
+ ^ DIAGNOSTICS .*?
+ ^ EXAMPLES .*?
+ ^ ENVIRONMENT .*?
+ ^ SEE\ ALSO .*?
+ ^ AUTHOR .*?
+ ^ COPYRIGHT .*?
+ ^ LICENCE .*?
+ ^ VERSION .*?
+ ^ DATE .*?
+ ^ HISTORY /mosx,
+ '-m option works');
+ }
+ }
}
#===============================================================================
@@ -7,7 +7,8 @@
# Test script to check PAR::Filter::Crypto module (and decryption filter).
#
# COPYRIGHT
-# Copyright (C) 2004-2006, 2008-2009, 2012 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2006, 2008-2009, 2012, 2014 Steve Hay. All rights
+# reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -15,7 +16,7 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -26,6 +27,8 @@ use File::Spec::Functions qw(canonpath catdir catfile curdir updir);
use FindBin qw($Bin);
use Test::More;
+sub new_filename();
+
#===============================================================================
# INITIALIZATION
#===============================================================================
@@ -33,6 +36,12 @@ use Test::More;
my($pp);
BEGIN {
+ my $i = 0;
+ sub new_filename() {
+ $i++;
+ return "test$i$Config{_exe}";
+ }
+
my $top_dir = canonpath(abs_path(catdir($Bin, updir())));
my $lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');
@@ -74,23 +83,14 @@ BEGIN {
#===============================================================================
MAIN: {
- my $fh;
- my $mbfile = 'myblib.pm';
- my $mbname = 'myblib';
my $ifile = 'test.pl';
- my $ofile = "test$Config{_exe}";
my $str = 'Hello, world.';
my $prog = qq[use strict; print "$str\\n";\n];
my $head = 'use Filter::Crypto::Decrypt;';
-
- # Before 5.7.3, -Mblib emitted a "Using ..." message on STDERR, which looks
- # ugly when we spawn a child perl process and breaks the --silent test.
- open $fh, ">$mbfile" or die "Can't create file '$mbfile': $!\n";
- print $fh qq[local \$SIG{__WARN__} = sub { };\neval 'use blib';\n1;\n];
- close $fh;
+ my $qrhead = qr/^\Q$head\E/o;
my $perl_exe = $^X =~ / /o ? qq["$^X"] : $^X;
- my $perl = qq[$perl_exe -M$mbname];
+ my $perl = qq[$perl_exe -Mblib];
my $have_archive_zip = eval { require Archive::Zip; 1 };
my $have_broken_module_scandeps;
@@ -98,80 +98,85 @@ MAIN: {
$have_broken_module_scandeps = ($Module::ScanDeps::VERSION eq '0.75');
}
- my($line, $cur_ofile);
-
- unlink $ifile or die "Can't delete file '$ifile': $!\n" if -e $ifile;
- unlink $ofile or die "Can't delete file '$ofile': $!\n" if -e $ofile;
+ my($fh, $ofile, $line, $cur_ofile);
open $fh, ">$ifile" or die "Can't create file '$ifile': $!\n";
print $fh $prog;
close $fh;
- qx{$perl $pp -f Crypto -M Filter::Crypto::Decrypt -o $ofile $ifile};
- is($?, 0, 'pp -f Crypto exited successfully');
- cmp_ok(-s $ofile, '>', 0, '... and created a non-zero size PAR archive');
-
- SKIP: {
- skip 'Archive::Zip required to inspect PAR archive', 5
- unless $have_archive_zip;
-
- my $zip = Archive::Zip->new() or die "Can't create new Archive::Zip\n";
- my $ret = eval { $zip->read($ofile) };
- is($@, '', 'No exceptions were thrown reading the PAR archive');
- is($ret, Archive::Zip::AZ_OK(), '... and read() returned OK');
- like($zip->contents("script/$ifile"), qr/^\Q$head\E/,
- '... and the script contents are as expected');
- unlike($zip->contents("lib/strict.pm"), qr/^\Q$head\E/,
- '... and the included module contents are as expected');
- unlike($zip->contents("lib/Filter/Crypto/Decrypt.pm"), qr/^\Q$head\E/,
- '... and the decryption module contents are as expected');
+ {
+ $ofile = new_filename();
+
+ qx{$perl $pp -f Crypto -M Filter::Crypto::Decrypt -o $ofile $ifile};
+ is($?, 0, 'pp -f Crypto exited successfully');
+ cmp_ok(-s $ofile, '>', 0, '... and created a non-zero size PAR archive');
+
+ SKIP: {
+ skip 'Archive::Zip required to inspect PAR archive', 5
+ unless $have_archive_zip;
+
+ my $zip = Archive::Zip->new() or die "Can't create new Archive::Zip\n";
+ my $ret = eval { $zip->read($ofile) };
+ is($@, '', 'No exceptions were thrown reading the PAR archive');
+ is($ret, Archive::Zip::AZ_OK(), '... and read() returned OK');
+ like($zip->contents("script/$ifile"), $qrhead,
+ '... and the script contents are as expected');
+ unlike($zip->contents("lib/strict.pm"), $qrhead,
+ '... and the included module contents are as expected');
+ unlike($zip->contents("lib/Filter/Crypto/Decrypt.pm"), $qrhead,
+ '... and the decryption module contents are as expected');
+ }
+
+ SKIP: {
+ skip "Module::ScanDeps $Module::ScanDeps::VERSION is broken", 1
+ if $have_broken_module_scandeps;
+
+ # Some platforms search the directories in PATH before the current
+ # directory so be explicit which file we want to run.
+ $cur_ofile = catfile(curdir(), $ofile);
+ chomp($line = qx{$cur_ofile});
+ is($line, $str, 'Running the PAR archive produces the expected output');
+ }
+
+ unlink $ofile;
}
- SKIP: {
- skip "Module::ScanDeps $Module::ScanDeps::VERSION is broken", 1
- if $have_broken_module_scandeps;
-
- # Some platforms search the directories in PATH before the current
- # directory so be explicit which file we want to run.
- $cur_ofile = catfile(curdir(), $ofile);
- chomp($line = qx{$cur_ofile});
- is($line, $str, 'Running the PAR archive produces the expected output');
- }
-
- unlink $ofile;
-
- qx{$perl $pp -f Crypto -F Crypto -M Filter::Crypto::Decrypt -o $ofile $ifile};
- is($?, 0, 'pp -f Crypto -F Crypto exited successfully');
- cmp_ok(-s $ofile, '>', 0, '... and created a non-zero size PAR archive');
-
- SKIP: {
- skip 'Archive::Zip required to inspect PAR archive', 5
- unless $have_archive_zip;
-
- my $zip = Archive::Zip->new() or die "Can't create new Archive::Zip\n";
- my $ret = eval { $zip->read($ofile) };
- is($@, '', 'No exceptions were thrown reading the PAR archive');
- is($ret, Archive::Zip::AZ_OK(), '... and read() returned OK');
- like($zip->contents("script/$ifile"), qr/^\Q$head\E/,
- '... and the script contents are as expected');
- like($zip->contents("lib/strict.pm"), qr/^\Q$head\E/,
- '... and the included module contents are as expected');
- unlike($zip->contents("lib/Filter/Crypto/Decrypt.pm"), qr/^\Q$head\E/,
- '... and the decryption module contents are as expected');
- }
-
- SKIP: {
- skip "Module::ScanDeps $Module::ScanDeps::VERSION is broken", 1
- if $have_broken_module_scandeps;
-
- # Some platforms search the directories in PATH before the current
- # directory so be explicit which file we want to run.
- $cur_ofile = catfile(curdir(), $ofile);
- chomp($line = qx{$cur_ofile});
- is($line, $str, 'Running the PAR archive produces the expected output');
+ {
+ $ofile = new_filename();
+
+ qx{$perl $pp -f Crypto -F Crypto -M Filter::Crypto::Decrypt -o $ofile $ifile};
+ is($?, 0, 'pp -f Crypto -F Crypto exited successfully');
+ cmp_ok(-s $ofile, '>', 0, '... and created a non-zero size PAR archive');
+
+ SKIP: {
+ skip 'Archive::Zip required to inspect PAR archive', 5
+ unless $have_archive_zip;
+
+ my $zip = Archive::Zip->new() or die "Can't create new Archive::Zip\n";
+ my $ret = eval { $zip->read($ofile) };
+ is($@, '', 'No exceptions were thrown reading the PAR archive');
+ is($ret, Archive::Zip::AZ_OK(), '... and read() returned OK');
+ like($zip->contents("script/$ifile"), $qrhead,
+ '... and the script contents are as expected');
+ like($zip->contents("lib/strict.pm"), $qrhead,
+ '... and the included module contents are as expected');
+ unlike($zip->contents("lib/Filter/Crypto/Decrypt.pm"), $qrhead,
+ '... and the decryption module contents are as expected');
+ }
+
+ SKIP: {
+ skip "Module::ScanDeps $Module::ScanDeps::VERSION is broken", 1
+ if $have_broken_module_scandeps;
+
+ # Some platforms search the directories in PATH before the current
+ # directory so be explicit which file we want to run.
+ $cur_ofile = catfile(curdir(), $ofile);
+ chomp($line = qx{$cur_ofile});
+ is($line, $str, 'Running the PAR archive produces the expected output');
+ }
+
+ unlink $ofile;
}
- unlink $mbfile;
unlink $ifile;
- unlink $ofile;
}
@@ -7,7 +7,7 @@
# Test script to check $ErrStr variable in Filter::Crypto::CryptFile.
#
# COPYRIGHT
-# Copyright (C) 2004-2006 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2006, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -15,7 +15,7 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -76,7 +76,7 @@ MAIN: {
unlink $iofile;
crypt_file($iofile);
- like($ErrStr, qr/^Can't open file '\Q$iofile\E'/,
+ like($ErrStr, qr/^Can't open file '\Q$iofile\E'/o,
'$ErrStr is set correctly when crypt_file() fails');
}
@@ -7,7 +7,7 @@
# Test script to check POD.
#
# COPYRIGHT
-# Copyright (C) 2004-2006, 2008 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2006, 2008, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -15,7 +15,7 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -18,7 +18,7 @@
# from the top-level directory.
#
# COPYRIGHT
-# Copyright (C) 2004-2006 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2006, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -26,7 +26,7 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -63,8 +63,6 @@ MAIN: {
my($fh, $interrupted, $i);
- unlink $file or die "Can't delete file '$file': $!\n" if -e $file;
-
open $fh, ">$file" or die "Can't create file '$file': $!\n";
print $fh $prog;
close $fh;
@@ -18,7 +18,7 @@
# from the top-level directory.
#
# COPYRIGHT
-# Copyright (C) 2004-2006 Steve Hay. All rights reserved.
+# Copyright (C) 2004-2006, 2014 Steve Hay. All rights reserved.
#
# LICENCE
# You may distribute under the terms of either the GNU General Public License
@@ -26,7 +26,7 @@
#
#===============================================================================
-use 5.006000;
+use 5.008001;
use strict;
use warnings;
@@ -72,9 +72,6 @@ MAIN: {
my($fh, $interrupted, $i);
- unlink $file1 or die "Can't delete file '$file1': $!\n" if -e $file1;
- unlink $file2 or die "Can't delete file '$file2': $!\n" if -e $file2;
-
open $fh, ">$file1" or die "Can't create file '$file1': $!\n";
print $fh $prog1;
close $fh;