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