r19318 - in /branches/upstream/libuniversal-require-perl: ./ current/ current/lib/ current/lib/UNIVERSAL/ current/t/
yvesago-guest at users.alioth.debian.org
yvesago-guest at users.alioth.debian.org
Thu May 1 13:38:56 UTC 2008
Author: yvesago-guest
Date: Thu May 1 13:38:55 2008
New Revision: 19318
URL: http://svn.debian.org/wsvn/?sc=1&rev=19318
Log:
[svn-inject] Installing original source of libuniversal-require-perl
Added:
branches/upstream/libuniversal-require-perl/
branches/upstream/libuniversal-require-perl/current/
branches/upstream/libuniversal-require-perl/current/Changes
branches/upstream/libuniversal-require-perl/current/MANIFEST
branches/upstream/libuniversal-require-perl/current/META.yml
branches/upstream/libuniversal-require-perl/current/Makefile.PL
branches/upstream/libuniversal-require-perl/current/lib/
branches/upstream/libuniversal-require-perl/current/lib/UNIVERSAL/
branches/upstream/libuniversal-require-perl/current/lib/UNIVERSAL/require.pm
branches/upstream/libuniversal-require-perl/current/t/
branches/upstream/libuniversal-require-perl/current/t/Dummy.pm
branches/upstream/libuniversal-require-perl/current/t/require.t
branches/upstream/libuniversal-require-perl/current/t/taint.t
branches/upstream/libuniversal-require-perl/current/t/use.t
Added: branches/upstream/libuniversal-require-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/Changes?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/Changes (added)
+++ branches/upstream/libuniversal-require-perl/current/Changes Thu May 1 13:38:55 2008
@@ -1,0 +1,17 @@
+0.10 Mon Oct 10 19:10:33 PDT 2005
+ * Split out of UNIVERSAL-exports into its own distribution.
+ * UNIVERSAL::require no longer uses eval STRING in require(). This
+ closes a security hole.
+ - Testing that it works under taint mode.
+ - Added license and copyright notice.
+ * Added use()
+ - Mention Module::Load in SEE ALSO.
+
+0.03 Sun Dec 16 21:51:58 EST 2001
+ - Fixed a little nit when "use UNIVERSAL" is involved.
+
+0.02 Mon Jun 25 15:00:19 EDT 2001
+ * -->API CHANGE!<-- require() no longer dies on failure
+
+0.01 Mon Jan 22 11:06:50 EST 2001
+ * First version, adapted from the Perl 6 RFC prototypes 253 and 257.
Added: branches/upstream/libuniversal-require-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/MANIFEST?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/MANIFEST (added)
+++ branches/upstream/libuniversal-require-perl/current/MANIFEST Thu May 1 13:38:55 2008
@@ -1,0 +1,9 @@
+Changes
+lib/UNIVERSAL/require.pm
+Makefile.PL
+MANIFEST This list of files
+t/Dummy.pm
+t/require.t
+t/taint.t
+t/use.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libuniversal-require-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/META.yml?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/META.yml (added)
+++ branches/upstream/libuniversal-require-perl/current/META.yml Thu May 1 13:38:55 2008
@@ -1,0 +1,13 @@
+--- #YAML:1.0
+name: UNIVERSAL-require
+version: 0.10
+abstract: ~
+license: perl
+generated_by: ExtUtils::MakeMaker version 6.30_01
+author: ~
+distribution_type: module
+requires:
+ Test::More: 0.47
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-new.html
+ version: 1.1
Added: branches/upstream/libuniversal-require-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/Makefile.PL?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/Makefile.PL (added)
+++ branches/upstream/libuniversal-require-perl/current/Makefile.PL Thu May 1 13:38:55 2008
@@ -1,0 +1,14 @@
+#!/usr/bin/perl -w
+
+use ExtUtils::MakeMaker;
+
+my $name = 'UNIVERSAL::require';
+my $version_from = "lib/$name.pm";
+$version_from =~ s{::}{/}g;
+
+WriteMakefile(
+ NAME => 'UNIVERSAL::require',
+ VERSION_FROM => $version_from,
+ LICENSE => 'perl',
+ PREREQ_PM => { Test::More => 0.47 },
+);
Added: branches/upstream/libuniversal-require-perl/current/lib/UNIVERSAL/require.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/lib/UNIVERSAL/require.pm?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/lib/UNIVERSAL/require.pm (added)
+++ branches/upstream/libuniversal-require-perl/current/lib/UNIVERSAL/require.pm Thu May 1 13:38:55 2008
@@ -1,0 +1,189 @@
+package UNIVERSAL::require;
+$UNIVERSAL::require::VERSION = '0.10';
+
+# We do this because UNIVERSAL.pm uses CORE::require(). We're going
+# to put our own require() into UNIVERSAL and that makes an ambiguity.
+# So we load it up beforehand to avoid that.
+BEGIN { require UNIVERSAL }
+
+package UNIVERSAL;
+
+use strict;
+
+use vars qw($Level);
+$Level = 0;
+
+=pod
+
+=head1 NAME
+
+ UNIVERSAL::require - require() modules from a variable
+
+=head1 SYNOPSIS
+
+ # This only needs to be said once in your program.
+ require UNIVERSAL::require;
+
+ # Same as "require Some::Module"
+ my $module = 'Some::Module';
+ $module->require or die $@;
+
+ # Same as "use Some::Module"
+ BEGIN { $module->use or die $@ }
+
+
+=head1 DESCRIPTION
+
+If you've ever had to do this...
+
+ eval "require $module";
+
+to get around the bareword caveats on require(), this module is for
+you. It creates a universal require() class method that will work
+with every Perl module and its secure. So instead of doing some
+arcane eval() work, you can do this:
+
+ $module->require;
+
+It doesn't save you much typing, but it'll make alot more sense to
+someone who's not a ninth level Perl acolyte.
+
+=head1 Methods
+
+=head3 require
+
+ my $return_val = $module->require or die $@;
+ my $return_val = $module->require($version) or die $@;
+
+This works exactly like Perl's require, except without the bareword
+restriction, and it doesn't die. Since require() is placed in the
+UNIVERSAL namespace, it will work on B<any> module. You just have to
+use UNIVERSAL::require somewhere in your code.
+
+Should the module require fail, or not be a high enough $version, it
+will simply return false and B<not die>. The error will be in
+$@ as well as $UNIVERSAL::require::ERROR.
+
+ $module->require or die $@;
+
+=cut
+
+sub require {
+ my($module, $want_version) = @_;
+
+ $UNIVERSAL::require::ERROR = '';
+
+ die("UNIVERSAL::require() can only be run as a class method")
+ if ref $module;
+
+ die("UNIVERSAL::require() takes no or one arguments") if @_ > 2;
+
+ my($call_package, $call_file, $call_line) = caller($Level);
+
+ # Load the module.
+ my $file = $module . '.pm';
+ $file =~ s{::}{/}g;
+ my $return = eval qq{
+#line $call_line "$call_file"
+CORE::require(\$file);
+};
+
+ # Check for module load failure.
+ if( $@ ) {
+ $UNIVERSAL::require::ERROR = $@;
+ return $return;
+ }
+
+ # Module version check.
+ if( @_ == 2 ) {
+ eval qq{
+#line $call_line "$call_file"
+\$module->VERSION($want_version);
+};
+
+ if( $@ ) {
+ $UNIVERSAL::require::ERROR = $@;
+ return 0;
+ }
+ }
+
+ return $return;
+}
+
+
+=head3 use
+
+ my $require_return = $module->use or die $@;
+ my $require_return = $module->use(@imports) or die $@;
+
+Like C<UNIVERSAL::require>, this allows you to C<use> a $module without
+having to eval to work around the bareword requirement. It returns the
+same as require.
+
+Should either the require or the import fail it will return false. The
+error will be in $@.
+
+If possible, call this inside a BEGIN block to emulate a normal C<use>
+as closely as possible.
+
+ BEGIN { $module->use }
+
+=cut
+
+sub use {
+ my($module, @imports) = @_;
+
+ local $Level = 1;
+ my $return = $module->require or return 0;
+
+ my($call_package, $call_file, $call_line) = caller;
+
+ eval qq{
+package $call_package;
+#line $call_line "$call_file"
+\$module->import(\@imports);
+};
+
+ if( $@ ) {
+ $UNIVERSAL::require::ERROR = $@;
+ return 0;
+ }
+
+ return $return;
+}
+
+
+=head1 SECURITY NOTES
+
+UNIVERSAL::require makes use of C<eval STRING>. In previous versions
+of UNIVERSAL::require it was discovered that one could craft a class
+name which would result in code being executed. This hole has been
+closed. The only variables now exposed to C<eval STRING> are the
+caller's package, filename and line which are not tainted.
+
+UNIVERSAL::require is taint clean.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001, 2005 by Michael G Schwern E<lt>schwern at pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+
+=head1 AUTHOR
+
+Michael G Schwern <schwern at pobox.com>
+
+
+=head1 SEE ALSO
+
+L<Module::Load>, L<perlfunc/require>, L<http://dev.perl.org/rfc/253.pod>
+
+=cut
+
+
+1;
Added: branches/upstream/libuniversal-require-perl/current/t/Dummy.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/t/Dummy.pm?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/t/Dummy.pm (added)
+++ branches/upstream/libuniversal-require-perl/current/t/Dummy.pm Thu May 1 13:38:55 2008
@@ -1,0 +1,16 @@
+package Dummy;
+
+require Exporter;
+
+ at ISA = qw(Exporter);
+ at EXPORT = qw(foo);
+ at EXPORT_OK = qw(bar);
+$VERSION = 0.5;
+
+sub foo { 42 }
+
+sub bar { 23 }
+
+sub car { "yarblockos" }
+
+return 23;
Added: branches/upstream/libuniversal-require-perl/current/t/require.t
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/t/require.t?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/t/require.t (added)
+++ branches/upstream/libuniversal-require-perl/current/t/require.t Thu May 1 13:38:55 2008
@@ -1,0 +1,36 @@
+#!/usr/bin/perl -Tw
+
+use Test::More tests => 11;
+use_ok "UNIVERSAL::require";
+
+use lib qw(t);
+
+
+is( Dummy->require, 23, 'require()' );
+is( $UNIVERSAL::require::ERROR, '', ' $ERROR empty' );
+ok( $Dummy::VERSION, ' $VERSION ok' );
+
+{
+ $SIG{__WARN__} = sub { warn @_
+ unless $_[0] =~ /^Subroutine \w+ redefined/ };
+ delete $INC{'Dummy.pm'};
+ is( Dummy->require(0.4), 23, 'require($version)' );
+ is( $UNIVERSAL::require::ERROR, '', ' $ERROR empty' );
+
+ delete $INC{'Dummy.pm'};
+ ok( !Dummy->require(1.0), 'require($version) fail' );
+ like( $UNIVERSAL::require::ERROR,
+ '/^Dummy version 1 required--this is only version 0.5/' );
+}
+
+{
+ my $warning = '';
+ local $SIG{__WARN__} = sub { $warning = join '', @_ };
+ eval 'use UNIVERSAL';
+ is( $warning, '', 'use UNIVERSAL doesnt interfere' );
+}
+
+
+my $evil = "Dummy; Test::More::fail('this should never be called');";
+ok !$evil->require;
+isnt $@, '';
Added: branches/upstream/libuniversal-require-perl/current/t/taint.t
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/t/taint.t?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/t/taint.t (added)
+++ branches/upstream/libuniversal-require-perl/current/t/taint.t Thu May 1 13:38:55 2008
@@ -1,0 +1,10 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use Test::More tests => 2;
+
+use UNIVERSAL::require;
+
+my $tainted = $0."bogus";
+ok !eval { $tainted->require or die $@};
+like $@, '/^Insecure dependency in require /';
Added: branches/upstream/libuniversal-require-perl/current/t/use.t
URL: http://svn.debian.org/wsvn/branches/upstream/libuniversal-require-perl/current/t/use.t?rev=19318&op=file
==============================================================================
--- branches/upstream/libuniversal-require-perl/current/t/use.t (added)
+++ branches/upstream/libuniversal-require-perl/current/t/use.t Thu May 1 13:38:55 2008
@@ -1,0 +1,22 @@
+#!/usr/bin/perl -Tw
+
+use Test::More tests => 10;
+use_ok "UNIVERSAL::require";
+
+use lib qw(t);
+
+my $Filename = quotemeta $0;
+
+is( Dummy->use, 23 );
+
+is( Dummy->use("foo", "bar"), 1 );
+is( foo(), 42 );
+is( bar(), 23 );
+
+ok( !Dummy->use(1) );
+is( $UNIVERSAL::require::ERROR, $@ );
+
+#line 23
+ok( !Dont::Exist->use );
+like( $@, qq[/^Can't locate Dont/Exist.pm in .* at $Filename line 23\./] );
+is( $UNIVERSAL::require::ERROR, $@ );
More information about the Pkg-perl-cvs-commits
mailing list