Latest update.
This commit is contained in:
@@ -0,0 +1,195 @@
|
||||
#! /usr/bin/env perl
|
||||
# Copyright 2016-2019 The OpenSSL Project Authors. All Rights Reserved.
|
||||
#
|
||||
# Licensed under the Apache License 2.0 (the "License"). You may not use
|
||||
# this file except in compliance with the License. You can obtain a copy
|
||||
# in the file LICENSE in the source distribution or at
|
||||
# https://www.openssl.org/source/license.html
|
||||
|
||||
# Implements the functionality to read one or more template files and run
|
||||
# them through Text::Template
|
||||
|
||||
package OpenSSL::Template;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
OpenSSL::Template - a private extension of Text::Template
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This provides exactly the functionality from Text::Template, with the
|
||||
following additions:
|
||||
|
||||
=over 4
|
||||
|
||||
=item -
|
||||
|
||||
The template perl code delimiters (given with the C<DELIMITER> option)
|
||||
are set to C<{-> and C<-}> by default.
|
||||
|
||||
=item -
|
||||
|
||||
A few extra functions are offered to be used by the template perl code, see
|
||||
L</Functions>.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
use File::Basename;
|
||||
use File::Spec::Functions;
|
||||
use Text::Template 1.46;
|
||||
|
||||
our @ISA = qw(Text::Template); # parent
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
# Call the constructor of the parent class.
|
||||
my $self = $class->SUPER::new(DELIMITERS => [ '{-', '-}'],
|
||||
@_ );
|
||||
|
||||
# Add few more attributes
|
||||
$self->{_output_off} = 0; # Default to output hunks
|
||||
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
sub fill_in {
|
||||
my $self = shift;
|
||||
my %opts = @_;
|
||||
my %hash = ( %{$opts{HASH}} );
|
||||
delete $opts{HASH};
|
||||
|
||||
$self->SUPER::fill_in(HASH => { quotify1 => \"ify1,
|
||||
quotify_l => \"ify_l,
|
||||
output_on => sub { $self->output_on() },
|
||||
output_off => sub { $self->output_off() },
|
||||
%hash },
|
||||
%opts);
|
||||
}
|
||||
|
||||
=head2 Functions
|
||||
|
||||
=cut
|
||||
|
||||
# Override Text::Template's append_text_to_result, as recommended here:
|
||||
#
|
||||
# http://search.cpan.org/~mjd/Text-Template-1.46/lib/Text/Template.pm#Automatic_postprocessing_of_template_hunks
|
||||
sub append_text_to_output {
|
||||
my $self = shift;
|
||||
|
||||
if ($self->{_output_off} == 0) {
|
||||
$self->SUPER::append_text_to_output(@_);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=begin comment
|
||||
|
||||
We lie about the OO nature of output_on() and output_off(), 'cause that's
|
||||
not how we pass them, see the HASH option used in fill_in() above
|
||||
|
||||
=end comment
|
||||
|
||||
=over 4
|
||||
|
||||
=item output_on()
|
||||
|
||||
=item output_off()
|
||||
|
||||
Switch on or off template output. Here's an example usage:
|
||||
|
||||
=over 4
|
||||
|
||||
{- output_off() if CONDITION -}
|
||||
whatever
|
||||
{- output_on() if CONDITION -}
|
||||
|
||||
=back
|
||||
|
||||
In this example, C<whatever> will only become part of the template output
|
||||
if C<CONDITION> is true.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub output_on {
|
||||
my $self = shift;
|
||||
if (--$self->{_output_off} < 0) {
|
||||
$self->{_output_off} = 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub output_off {
|
||||
my $self = shift;
|
||||
$self->{_output_off}++;
|
||||
}
|
||||
|
||||
# Helper functions for the templates #################################
|
||||
|
||||
# It might be practical to quotify some strings and have them protected
|
||||
# from possible harm. These functions primarily quote things that might
|
||||
# be interpreted wrongly by a perl eval.
|
||||
|
||||
# NOTE THAT THESE AREN'T CLASS METHODS!
|
||||
|
||||
=over 4
|
||||
|
||||
=item quotify1 STRING
|
||||
|
||||
This adds quotes (") around the given string, and escapes any $, @, \,
|
||||
" and ' by prepending a \ to them.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub quotify1 {
|
||||
my $s = shift @_;
|
||||
$s =~ s/([\$\@\\"'])/\\$1/g;
|
||||
'"'.$s.'"';
|
||||
}
|
||||
|
||||
=over 4
|
||||
|
||||
=item quotify_l LIST
|
||||
|
||||
For each defined element in LIST (i.e. elements that aren't undef), have
|
||||
it quotified with 'quotify1'.
|
||||
Undefined elements are ignored.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub quotify_l {
|
||||
map {
|
||||
if (!defined($_)) {
|
||||
();
|
||||
} else {
|
||||
quotify1($_);
|
||||
}
|
||||
} @_;
|
||||
}
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Text::Template>
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Richard Levitte E<lt>levitte@openssl.orgE<gt>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright 2016-2019 The OpenSSL Project Authors. All Rights Reserved.
|
||||
|
||||
Licensed under the Apache License 2.0 (the "License"). You may not use
|
||||
this file except in compliance with the License. You can obtain a copy
|
||||
in the file LICENSE in the source distribution or at
|
||||
L<https://www.openssl.org/source/license.html>.
|
||||
|
||||
=cut
|
||||
+31
-18
@@ -446,16 +446,21 @@ sub run {
|
||||
die "OpenSSL::Test::run(): statusvar value not a scalar reference"
|
||||
if $opts{statusvar} && ref($opts{statusvar}) ne "SCALAR";
|
||||
|
||||
# In non-verbose, we want to shut up the command interpreter, in case
|
||||
# it has something to complain about. On VMS, it might complain both
|
||||
# on stdout and stderr
|
||||
# For some reason, program output, or even output from this function
|
||||
# somehow isn't caught by TAP::Harness (TAP::Parser?) on VMS, so we're
|
||||
# silencing it specifically there until further notice.
|
||||
my $save_STDOUT;
|
||||
my $save_STDERR;
|
||||
if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) {
|
||||
open $save_STDOUT, '>&', \*STDOUT or die "Can't dup STDOUT: $!";
|
||||
open $save_STDERR, '>&', \*STDERR or die "Can't dup STDERR: $!";
|
||||
open STDOUT, ">", devnull();
|
||||
open STDERR, ">", devnull();
|
||||
if ($^O eq 'VMS') {
|
||||
# In non-verbose, we want to shut up the command interpreter, in case
|
||||
# it has something to complain about. On VMS, it might complain both
|
||||
# on stdout and stderr
|
||||
if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) {
|
||||
open $save_STDOUT, '>&', \*STDOUT or die "Can't dup STDOUT: $!";
|
||||
open $save_STDERR, '>&', \*STDERR or die "Can't dup STDERR: $!";
|
||||
open STDOUT, ">", devnull();
|
||||
open STDERR, ">", devnull();
|
||||
}
|
||||
}
|
||||
|
||||
$ENV{HARNESS_OSSL_LEVEL} = $level + 1;
|
||||
@@ -489,15 +494,20 @@ sub run {
|
||||
${$opts{statusvar}} = $r;
|
||||
}
|
||||
|
||||
if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) {
|
||||
close STDOUT;
|
||||
close STDERR;
|
||||
open STDOUT, '>&', $save_STDOUT or die "Can't restore STDOUT: $!";
|
||||
open STDERR, '>&', $save_STDERR or die "Can't restore STDERR: $!";
|
||||
}
|
||||
# Restore STDOUT / STDERR on VMS
|
||||
if ($^O eq 'VMS') {
|
||||
if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) {
|
||||
close STDOUT;
|
||||
close STDERR;
|
||||
open STDOUT, '>&', $save_STDOUT or die "Can't restore STDOUT: $!";
|
||||
open STDERR, '>&', $save_STDERR or die "Can't restore STDERR: $!";
|
||||
}
|
||||
|
||||
print STDERR "$prefix$display_cmd => $e\n"
|
||||
if !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE};
|
||||
print STDERR "$prefix$display_cmd => $e\n"
|
||||
if !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE};
|
||||
} else {
|
||||
print STDERR "$prefix$display_cmd => $e\n";
|
||||
}
|
||||
|
||||
# At this point, $? stops being interesting, and unfortunately,
|
||||
# there are Test::More versions that get picky if we leave it
|
||||
@@ -1244,8 +1254,11 @@ sub __decorate_cmd {
|
||||
|
||||
my $display_cmd = "$cmdstr$stdin$stdout$stderr";
|
||||
|
||||
$stderr=" 2> ".$null
|
||||
unless $stderr || !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE};
|
||||
# VMS program output escapes TAP::Parser
|
||||
if ($^O eq 'VMS') {
|
||||
$stderr=" 2> ".$null
|
||||
unless $stderr || !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE};
|
||||
}
|
||||
|
||||
$cmdstr .= "$stdin$stdout$stderr";
|
||||
|
||||
|
||||
@@ -0,0 +1,112 @@
|
||||
# Copyright 2019 The OpenSSL Project Authors. All Rights Reserved.
|
||||
#
|
||||
# Licensed under the Apache License 2.0 (the "License"). You may not use
|
||||
# this file except in compliance with the License. You can obtain a copy
|
||||
# in the file LICENSE in the source distribution or at
|
||||
# https://www.openssl.org/source/license.html
|
||||
|
||||
=head1 NAME
|
||||
|
||||
OpenSSL::fallback - push directories to the end of @INC at compile time
|
||||
|
||||
=cut
|
||||
|
||||
package OpenSSL::fallback;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
our $VERSION = '0.01';
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use OpenSSL::fallback LIST;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This small simple module simplifies the addition of fallback directories
|
||||
in @INC at compile time.
|
||||
|
||||
It is used to add extra directories at the end of perl's search path so
|
||||
that later "use" or "require" statements will find modules which are not
|
||||
located on perl's default search path.
|
||||
|
||||
This is similar to L<lib>, except the paths are I<appended> to @INC rather
|
||||
than prepended, thus allowing the use of a newer module on perl's default
|
||||
search path if there is one.
|
||||
|
||||
=head1 CAVEAT
|
||||
|
||||
Just like with B<lib>, this only works with Unix filepaths.
|
||||
Just like with L<lib>, this doesn't mean that it only works on Unix, but that
|
||||
non-Unix users must first translate their file paths to Unix conventions.
|
||||
|
||||
# VMS users wanting to put [.my.stuff] into their @INC should write:
|
||||
use fallback 'my/stuff';
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
If you try to add a file to @INC as follows, you will be warned, and the file
|
||||
will be ignored:
|
||||
|
||||
use fallback 'file.txt';
|
||||
|
||||
The sole exception is the file F<MODULES.txt>, which must contain a list of
|
||||
sub-directories relative to the location of that F<MODULES.txt> file.
|
||||
All these sub-directories will be appended to @INC.
|
||||
|
||||
=cut
|
||||
|
||||
# Forward declare
|
||||
sub glob;
|
||||
|
||||
use constant DEBUG => 0;
|
||||
|
||||
sub import {
|
||||
shift; # Skip module name
|
||||
|
||||
foreach (@_) {
|
||||
my $path = $_;
|
||||
|
||||
if ($path eq '') {
|
||||
carp "Empty compile time value given to use fallback";
|
||||
next;
|
||||
}
|
||||
|
||||
print STDERR "DEBUG: $path\n" if DEBUG;
|
||||
|
||||
unless (-e $path
|
||||
&& ($path =~ m/(?:^|\/)MODULES.txt/ || -d $path)) {
|
||||
croak "Parameter to use fallback must be a directory, not a file";
|
||||
next;
|
||||
}
|
||||
|
||||
my @dirs = ();
|
||||
if (-f $path) { # It's a MODULES.txt file
|
||||
(my $dir = $path) =~ s|/[^/]*$||; # quick dirname
|
||||
open my $fh, $path or die "Could not open $path: $!\n";
|
||||
while (my $l = <$fh>) {
|
||||
$l =~ s|\R$||; # Better chomp
|
||||
my $d = "$dir/$l";
|
||||
croak "All lines in $path must be a directory, not a file: $l"
|
||||
unless -e $d && -d $d;
|
||||
push @INC, $d;
|
||||
}
|
||||
} else { # It's a directory
|
||||
push @INC, $path;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<FindBin> - optional module which deals with paths relative to the source
|
||||
file.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Richard Levitte, 2019
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,105 @@
|
||||
# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
|
||||
#
|
||||
# Licensed under the Apache License 2.0 (the "License"). You may not use
|
||||
# this file except in compliance with the License. You can obtain a copy
|
||||
# in the file LICENSE in the source distribution or at
|
||||
# https://www.openssl.org/source/license.html
|
||||
|
||||
use strict;
|
||||
|
||||
package TLSProxy::CertificateRequest;
|
||||
|
||||
use vars '@ISA';
|
||||
push @ISA, 'TLSProxy::Message';
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my ($server,
|
||||
$data,
|
||||
$records,
|
||||
$startoffset,
|
||||
$message_frag_lens) = @_;
|
||||
|
||||
my $self = $class->SUPER::new(
|
||||
$server,
|
||||
TLSProxy::Message::MT_CERTIFICATE_REQUEST,
|
||||
$data,
|
||||
$records,
|
||||
$startoffset,
|
||||
$message_frag_lens);
|
||||
|
||||
$self->{extension_data} = "";
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub parse
|
||||
{
|
||||
my $self = shift;
|
||||
my $ptr = 1;
|
||||
|
||||
if (TLSProxy::Proxy->is_tls13()) {
|
||||
my $request_ctx_len = unpack('C', $self->data);
|
||||
my $request_ctx = substr($self->data, $ptr, $request_ctx_len);
|
||||
$ptr += $request_ctx_len;
|
||||
|
||||
my $extensions_len = unpack('n', substr($self->data, $ptr));
|
||||
$ptr += 2;
|
||||
my $extension_data = substr($self->data, $ptr);
|
||||
if (length($extension_data) != $extensions_len) {
|
||||
die "Invalid extension length\n";
|
||||
}
|
||||
my %extensions = ();
|
||||
while (length($extension_data) >= 4) {
|
||||
my ($type, $size) = unpack("nn", $extension_data);
|
||||
my $extdata = substr($extension_data, 4, $size);
|
||||
$extension_data = substr($extension_data, 4 + $size);
|
||||
$extensions{$type} = $extdata;
|
||||
}
|
||||
$self->extension_data(\%extensions);
|
||||
|
||||
print " Extensions Len:".$extensions_len."\n";
|
||||
}
|
||||
# else parse TLSv1.2 version - we don't support that at the moment
|
||||
}
|
||||
|
||||
#Reconstruct the on-the-wire message data following changes
|
||||
sub set_message_contents
|
||||
{
|
||||
my $self = shift;
|
||||
my $data;
|
||||
my $extensions = "";
|
||||
|
||||
foreach my $key (keys %{$self->extension_data}) {
|
||||
my $extdata = ${$self->extension_data}{$key};
|
||||
$extensions .= pack("n", $key);
|
||||
$extensions .= pack("n", length($extdata));
|
||||
$extensions .= $extdata;
|
||||
}
|
||||
|
||||
$data = pack('n', length($extensions));
|
||||
$data .= $extensions;
|
||||
$self->data($data);
|
||||
}
|
||||
|
||||
#Read/write accessors
|
||||
sub extension_data
|
||||
{
|
||||
my $self = shift;
|
||||
if (@_) {
|
||||
$self->{extension_data} = shift;
|
||||
}
|
||||
return $self->{extension_data};
|
||||
}
|
||||
sub set_extension
|
||||
{
|
||||
my ($self, $ext_type, $ext_data) = @_;
|
||||
$self->{extension_data}{$ext_type} = $ext_data;
|
||||
}
|
||||
sub delete_extension
|
||||
{
|
||||
my ($self, $ext_type) = @_;
|
||||
delete $self->{extension_data}{$ext_type};
|
||||
}
|
||||
1;
|
||||
@@ -129,6 +129,11 @@ use constant {
|
||||
CIPHER_TLS13_AES_256_GCM_SHA384 => 0x1302
|
||||
};
|
||||
|
||||
use constant {
|
||||
CLIENT => 0,
|
||||
SERVER => 1
|
||||
};
|
||||
|
||||
my $payload = "";
|
||||
my $messlen = -1;
|
||||
my $mt;
|
||||
@@ -338,6 +343,15 @@ sub create_message
|
||||
[@message_frag_lens]
|
||||
);
|
||||
$message->parse();
|
||||
} elsif ($mt == MT_CERTIFICATE_REQUEST) {
|
||||
$message = TLSProxy::CertificateRequest->new(
|
||||
$server,
|
||||
$data,
|
||||
[@message_rec_list],
|
||||
$startoffset,
|
||||
[@message_frag_lens]
|
||||
);
|
||||
$message->parse();
|
||||
} elsif ($mt == MT_CERTIFICATE_VERIFY) {
|
||||
$message = TLSProxy::CertificateVerify->new(
|
||||
$server,
|
||||
|
||||
@@ -19,6 +19,7 @@ use TLSProxy::ClientHello;
|
||||
use TLSProxy::ServerHello;
|
||||
use TLSProxy::EncryptedExtensions;
|
||||
use TLSProxy::Certificate;
|
||||
use TLSProxy::CertificateRequest;
|
||||
use TLSProxy::CertificateVerify;
|
||||
use TLSProxy::ServerKeyExchange;
|
||||
use TLSProxy::NewSessionTicket;
|
||||
|
||||
@@ -116,7 +116,8 @@ sub checkhandshake($$$$)
|
||||
&& $message->mt() != TLSProxy::Message::MT_SERVER_HELLO
|
||||
&& $message->mt() !=
|
||||
TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS
|
||||
&& $message->mt() != TLSProxy::Message::MT_CERTIFICATE);
|
||||
&& $message->mt() != TLSProxy::Message::MT_CERTIFICATE
|
||||
&& $message->mt() != TLSProxy::Message::MT_CERTIFICATE_REQUEST);
|
||||
|
||||
next if $message->mt() == TLSProxy::Message::MT_CERTIFICATE
|
||||
&& !TLSProxy::Proxy::is_tls13();
|
||||
@@ -124,7 +125,7 @@ sub checkhandshake($$$$)
|
||||
my $extchnum = 1;
|
||||
my $extshnum = 1;
|
||||
for (my $extloop = 0;
|
||||
$extensions[$extloop][2] != 0;
|
||||
$extensions[$extloop][3] != 0;
|
||||
$extloop++) {
|
||||
$extchnum = 2 if $extensions[$extloop][0] != TLSProxy::Message::MT_CLIENT_HELLO
|
||||
&& TLSProxy::Proxy::is_tls13();
|
||||
@@ -135,6 +136,7 @@ sub checkhandshake($$$$)
|
||||
next if $extensions[$extloop][0] == TLSProxy::Message::MT_SERVER_HELLO
|
||||
&& $extshnum != $shnum;
|
||||
next if ($message->mt() != $extensions[$extloop][0]);
|
||||
next if ($message->server() != $extensions[$extloop][2]);
|
||||
$numtests++;
|
||||
}
|
||||
$numtests++;
|
||||
@@ -182,7 +184,8 @@ sub checkhandshake($$$$)
|
||||
&& $message->mt() != TLSProxy::Message::MT_SERVER_HELLO
|
||||
&& $message->mt() !=
|
||||
TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS
|
||||
&& $message->mt() != TLSProxy::Message::MT_CERTIFICATE);
|
||||
&& $message->mt() != TLSProxy::Message::MT_CERTIFICATE
|
||||
&& $message->mt() != TLSProxy::Message::MT_CERTIFICATE_REQUEST);
|
||||
|
||||
next if $message->mt() == TLSProxy::Message::MT_CERTIFICATE
|
||||
&& !TLSProxy::Proxy::is_tls13();
|
||||
@@ -197,7 +200,7 @@ sub checkhandshake($$$$)
|
||||
my $msgexts = $message->extension_data();
|
||||
my $extchnum = 1;
|
||||
my $extshnum = 1;
|
||||
for (my $extloop = 0, $extcount = 0; $extensions[$extloop][2] != 0;
|
||||
for (my $extloop = 0, $extcount = 0; $extensions[$extloop][3] != 0;
|
||||
$extloop++) {
|
||||
#In TLSv1.3 we can have two ClientHellos if there has been a
|
||||
#HelloRetryRequest, and they may have different extensions. Skip
|
||||
@@ -211,12 +214,13 @@ sub checkhandshake($$$$)
|
||||
next if $extensions[$extloop][0] == TLSProxy::Message::MT_SERVER_HELLO
|
||||
&& $extshnum != $shnum;
|
||||
next if ($message->mt() != $extensions[$extloop][0]);
|
||||
ok (($extensions[$extloop][2] & $exttype) == 0
|
||||
next if ($message->server() != $extensions[$extloop][2]);
|
||||
ok (($extensions[$extloop][3] & $exttype) == 0
|
||||
|| defined ($msgexts->{$extensions[$extloop][1]}),
|
||||
"Extension presence check (Message: ".$message->mt()
|
||||
." Extension: ".($extensions[$extloop][2] & $exttype).", "
|
||||
." Extension: ".($extensions[$extloop][3] & $exttype).", "
|
||||
.$extloop.")");
|
||||
$extcount++ if (($extensions[$extloop][2] & $exttype) != 0);
|
||||
$extcount++ if (($extensions[$extloop][3] & $exttype) != 0);
|
||||
}
|
||||
ok($extcount == keys %$msgexts, "Extensions count mismatch ("
|
||||
.$extcount.", ".(keys %$msgexts)
|
||||
|
||||
@@ -1,27 +0,0 @@
|
||||
# Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved.
|
||||
#
|
||||
# Licensed under the Apache License 2.0 (the "License"). You may not use
|
||||
# this file except in compliance with the License. You can obtain a copy
|
||||
# in the file LICENSE in the source distribution or at
|
||||
# https://www.openssl.org/source/license.html
|
||||
|
||||
package with_fallback;
|
||||
|
||||
sub import {
|
||||
shift;
|
||||
|
||||
use File::Basename;
|
||||
use File::Spec::Functions;
|
||||
foreach (@_) {
|
||||
eval "use $_";
|
||||
if ($@) {
|
||||
unshift @INC, catdir(dirname(__FILE__),
|
||||
"..", "..", "external", "perl");
|
||||
my $transfer = "transfer::$_";
|
||||
eval "use $transfer";
|
||||
shift @INC;
|
||||
warn $@ if $@;
|
||||
}
|
||||
}
|
||||
}
|
||||
1;
|
||||
Reference in New Issue
Block a user