STLExtract 1.0.0

data/Slic3r/Linux/lib/std/LWP/Authen/Basic.pm

@@ -0,0 +1,65 @@
+package LWP::Authen::Basic;
+use strict;
+
+require MIME::Base64;
+
+sub auth_header {
+    my($class, $user, $pass) = @_;
+    return "Basic " . MIME::Base64::encode("$user:$pass", "");
+}
+
+sub authenticate
+{
+    my($class, $ua, $proxy, $auth_param, $response,
+       $request, $arg, $size) = @_;
+
+    my $realm = $auth_param->{realm} || "";
+    my $url = $proxy ? $request->{proxy} : $request->uri_canonical;
+    return $response unless $url;
+    my $host_port = $url->host_port;
+    my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
+
+    my @m = $proxy ? (m_proxy => $url) : (m_host_port => $host_port);
+    push(@m, realm => $realm);
+
+    my $h = $ua->get_my_handler("request_prepare", @m, sub {
+        $_[0]{callback} = sub {
+            my($req, $ua, $h) = @_;
+            my($user, $pass) = $ua->credentials($host_port, $h->{realm});
+	    if (defined $user) {
+		my $auth_value = $class->auth_header($user, $pass, $req, $ua, $h);
+		$req->header($auth_header => $auth_value);
+	    }
+        };
+    });
+    $h->{auth_param} = $auth_param;
+
+    if (!$proxy && !$request->header($auth_header) && $ua->credentials($host_port, $realm)) {
+	# we can make sure this handler applies and retry
+        add_path($h, $url->path);
+        return $ua->request($request->clone, $arg, $size, $response);
+    }
+
+    my($user, $pass) = $ua->get_basic_credentials($realm, $url, $proxy);
+    unless (defined $user and defined $pass) {
+	$ua->set_my_handler("request_prepare", undef, @m);  # delete handler
+	return $response;
+    }
+
+    # check that the password has changed
+    my ($olduser, $oldpass) = $ua->credentials($host_port, $realm);
+    return $response if (defined $olduser and defined $oldpass and
+                         $user eq $olduser and $pass eq $oldpass);
+
+    $ua->credentials($host_port, $realm, $user, $pass);
+    add_path($h, $url->path) unless $proxy;
+    return $ua->request($request->clone, $arg, $size, $response);
+}
+
+sub add_path {
+    my($h, $path) = @_;
+    $path =~ s,[^/]+\z,,;
+    push(@{$h->{m_path_prefix}}, $path);
+}
+
+1;

data/Slic3r/Linux/lib/std/LWP/Authen/Digest.pm

@@ -0,0 +1,68 @@
+package LWP::Authen::Digest;
+
+use strict;
+use base 'LWP::Authen::Basic';
+
+require Digest::MD5;
+
+sub auth_header {
+    my($class, $user, $pass, $request, $ua, $h) = @_;
+
+    my $auth_param = $h->{auth_param};
+
+    my $nc = sprintf "%08X", ++$ua->{authen_md5_nonce_count}{$auth_param->{nonce}};
+    my $cnonce = sprintf "%8x", time;
+
+    my $uri = $request->uri->path_query;
+    $uri = "/" unless length $uri;
+
+    my $md5 = Digest::MD5->new;
+
+    my(@digest);
+    $md5->add(join(":", $user, $auth_param->{realm}, $pass));
+    push(@digest, $md5->hexdigest);
+    $md5->reset;
+
+    push(@digest, $auth_param->{nonce});
+
+    if ($auth_param->{qop}) {
+	push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop});
+    }
+
+    $md5->add(join(":", $request->method, $uri));
+    push(@digest, $md5->hexdigest);
+    $md5->reset;
+
+    $md5->add(join(":", @digest));
+    my($digest) = $md5->hexdigest;
+    $md5->reset;
+
+    my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque);
+    @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5");
+
+    if (($auth_param->{qop} || "") =~ m|^auth([,;]auth-int)?$|) {
+	@resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc);
+    }
+
+    my(@order) = qw(username realm qop algorithm uri nonce nc cnonce response);
+    if($request->method =~ /^(?:POST|PUT)$/) {
+	$md5->add($request->content);
+	my $content = $md5->hexdigest;
+	$md5->reset;
+	$md5->add(join(":", @digest[0..1], $content));
+	$md5->reset;
+	$resp{"message-digest"} = $md5->hexdigest;
+	push(@order, "message-digest");
+    }
+    push(@order, "opaque");
+    my @pairs;
+    for (@order) {
+	next unless defined $resp{$_};
+	push(@pairs, "$_=" . qq("$resp{$_}"));
+    }
+
+    my $auth_value  = "Digest " . join(", ", @pairs);
+    return $auth_value;
+}
+
+1;

data/Slic3r/Linux/lib/std/LWP/Authen/Ntlm.pm

@@ -0,0 +1,180 @@
+package LWP::Authen::Ntlm;
+
+use strict;
+use vars qw/$VERSION/;
+
+$VERSION = "6.00";
+
+use Authen::NTLM "1.02";
+use MIME::Base64 "2.12";
+
+sub authenticate {
+    my($class, $ua, $proxy, $auth_param, $response,
+       $request, $arg, $size) = @_;
+
+    my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
+                                                  $request->uri, $proxy);
+
+    unless(defined $user and defined $pass) {
+		return $response;
+	}
+
+	if (!$ua->conn_cache()) {
+		warn "The keep_alive option must be enabled for NTLM authentication to work.  NTLM authentication aborted.\n";
+		return $response;
+	}
+
+	my($domain, $username) = split(/\\/, $user);
+
+	ntlm_domain($domain);
+	ntlm_user($username);
+	ntlm_password($pass);
+
+    my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
+
+	# my ($challenge) = $response->header('WWW-Authenticate'); 
+	my $challenge;
+	foreach ($response->header('WWW-Authenticate')) { 
+		last if /^NTLM/ && ($challenge=$_);
+	}
+
+	if ($challenge eq 'NTLM') {
+		# First phase, send handshake
+	    my $auth_value = "NTLM " . ntlm();
+		ntlm_reset();
+
+	    # Need to check this isn't a repeated fail!
+	    my $r = $response;
+		my $retry_count = 0;
+	    while ($r) {
+			my $auth = $r->request->header($auth_header);
+			++$retry_count if ($auth && $auth eq $auth_value);
+			if ($retry_count > 2) {
+				    # here we know this failed before
+				    $response->header("Client-Warning" =>
+						      "Credentials for '$user' failed before");
+				    return $response;
+			}
+			$r = $r->previous;
+	    }
+
+	    my $referral = $request->clone;
+	    $referral->header($auth_header => $auth_value);
+	    return $ua->request($referral, $arg, $size, $response);
+	}
+	
+	else {
+		# Second phase, use the response challenge (unless non-401 code
+		#  was returned, in which case, we just send back the response
+		#  object, as is
+		my $auth_value;
+		if ($response->code ne '401') {
+			return $response;
+		}
+		else {
+			my $challenge;
+			foreach ($response->header('WWW-Authenticate')) { 
+				last if /^NTLM/ && ($challenge=$_);
+			}
+			$challenge =~ s/^NTLM //;
+			ntlm();
+			$auth_value = "NTLM " . ntlm($challenge);
+			ntlm_reset();
+		}
+
+	    my $referral = $request->clone;
+	    $referral->header($auth_header => $auth_value);
+	    my $response2 = $ua->request($referral, $arg, $size, $response);
+		return $response2;
+	}
+}
+
+1;
+
+
+=head1 NAME
+
+LWP::Authen::Ntlm - Library for enabling NTLM authentication (Microsoft) in LWP
+
+=head1 SYNOPSIS
+
+ use LWP::UserAgent;
+ use HTTP::Request::Common;
+ my $url = 'http://www.company.com/protected_page.html';
+
+ # Set up the ntlm client and then the base64 encoded ntlm handshake message
+ my $ua = LWP::UserAgent->new(keep_alive=>1);
+ $ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword');
+
+ $request = GET $url;
+ print "--Performing request now...-----------\n";
+ $response = $ua->request($request);
+ print "--Done with request-------------------\n";
+
+ if ($response->is_success) {print "It worked!->" . $response->code . "\n"}
+ else {print "It didn't work!->" . $response->code . "\n"}
+
+=head1 DESCRIPTION
+
+C<LWP::Authen::Ntlm> allows LWP to authenticate against servers that are using the 
+NTLM authentication scheme popularized by Microsoft.  This type of authentication is 
+common on intranets of Microsoft-centric organizations.
+
+The module takes advantage of the Authen::NTLM module by Mark Bush.  Since there 
+is also another Authen::NTLM module available from CPAN by Yee Man Chan with an 
+entirely different interface, it is necessary to ensure that you have the correct 
+NTLM module.
+
+In addition, there have been problems with incompatibilities between different 
+versions of Mime::Base64, which Bush's Authen::NTLM makes use of.  Therefore, it is 
+necessary to ensure that your Mime::Base64 module supports exporting of the 
+encode_base64 and decode_base64 functions.
+
+=head1 USAGE
+
+The module is used indirectly through LWP, rather than including it directly in your 
+code.  The LWP system will invoke the NTLM authentication when it encounters the 
+authentication scheme while attempting to retrieve a URL from a server.  In order 
+for the NTLM authentication to work, you must have a few things set up in your 
+code prior to attempting to retrieve the URL:
+
+=over 4
+
+=item *
+
+Enable persistent HTTP connections
+
+To do this, pass the "keep_alive=>1" option to the LWP::UserAgent when creating it, like this:
+
+    my $ua = LWP::UserAgent->new(keep_alive=>1);
+
+=item *
+
+Set the credentials on the UserAgent object
+
+The credentials must be set like this:
+
+   $ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword');
+
+Note that you cannot use the HTTP::Request object's authorization_basic() method to set 
+the credentials.  Note, too, that the 'www.company.com:80' portion only sets credentials 
+on the specified port AND it is case-sensitive (this is due to the way LWP is coded, and 
+has nothing to do with LWP::Authen::Ntlm)
+
+=back
+
+=head1 AVAILABILITY
+
+General queries regarding LWP should be made to the LWP Mailing List.
+
+Questions specific to LWP::Authen::Ntlm can be forwarded to jtillman@bigfoot.com
+
+=head1 COPYRIGHT
+
+Copyright (c) 2002 James Tillman. All rights reserved. This
+program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<LWP>, L<LWP::UserAgent>, L<lwpcook>.

data/Slic3r/Linux/lib/std/LWP/ConnCache.pm

@@ -0,0 +1,313 @@
+package LWP::ConnCache;
+
+use strict;
+use vars qw($VERSION $DEBUG);
+
+$VERSION = "6.02";
+
+
+sub new {
+    my($class, %cnf) = @_;
+
+    my $total_capacity = 1;
+    if (exists $cnf{total_capacity}) {
+        $total_capacity = delete $cnf{total_capacity};
+    }
+    if (%cnf && $^W) {
+	require Carp;
+	Carp::carp("Unrecognised options: @{[sort keys %cnf]}")
+    }
+    my $self = bless { cc_conns => [] }, $class;
+    $self->total_capacity($total_capacity);
+    $self;
+}
+
+
+sub deposit {
+    my($self, $type, $key, $conn) = @_;
+    push(@{$self->{cc_conns}}, [$conn, $type, $key, time]);
+    $self->enforce_limits($type);
+    return;
+}
+
+
+sub withdraw {
+    my($self, $type, $key) = @_;
+    my $conns = $self->{cc_conns};
+    for my $i (0 .. @$conns - 1) {
+	my $c = $conns->[$i];
+	next unless $c->[1] eq $type && $c->[2] eq $key;
+	splice(@$conns, $i, 1);  # remove it
+	return $c->[0];
+    }
+    return undef;
+}
+
+
+sub total_capacity {
+    my $self = shift;
+    my $old = $self->{cc_limit_total};
+    if (@_) {
+	$self->{cc_limit_total} = shift;
+	$self->enforce_limits;
+    }
+    $old;
+}
+
+
+sub capacity {
+    my $self = shift;
+    my $type = shift;
+    my $old = $self->{cc_limit}{$type};
+    if (@_) {
+	$self->{cc_limit}{$type} = shift;
+	$self->enforce_limits($type);
+    }
+    $old;
+}
+
+
+sub enforce_limits {
+    my($self, $type) = @_;
+    my $conns = $self->{cc_conns};
+
+    my @types = $type ? ($type) : ($self->get_types);
+    for $type (@types) {
+	next unless $self->{cc_limit};
+	my $limit = $self->{cc_limit}{$type};
+	next unless defined $limit;
+	for my $i (reverse 0 .. @$conns - 1) {
+	    next unless $conns->[$i][1] eq $type;
+	    if (--$limit < 0) {
+		$self->dropping(splice(@$conns, $i, 1), "$type capacity exceeded");
+	    }
+	}
+    }
+
+    if (defined(my $total = $self->{cc_limit_total})) {
+	while (@$conns > $total) {
+	    $self->dropping(shift(@$conns), "Total capacity exceeded");
+	}
+    }
+}
+
+
+sub dropping {
+    my($self, $c, $reason) = @_;
+    print "DROPPING @$c [$reason]\n" if $DEBUG;
+}
+
+
+sub drop {
+    my($self, $checker, $reason) = @_;
+    if (ref($checker) ne "CODE") {
+	# make it so
+	if (!defined $checker) {
+	    $checker = sub { 1 };  # drop all of them
+	}
+	elsif (_looks_like_number($checker)) {
+	    my $age_limit = $checker;
+	    my $time_limit = time - $age_limit;
+	    $reason ||= "older than $age_limit";
+	    $checker = sub { $_[3] < $time_limit };
+	}
+	else {
+	    my $type = $checker;
+	    $reason ||= "drop $type";
+	    $checker = sub { $_[1] eq $type };  # match on type
+	}
+    }
+    $reason ||= "drop";
+
+    local $SIG{__DIE__};  # don't interfere with eval below
+    local $@;
+    my @c;
+    for (@{$self->{cc_conns}}) {
+	my $drop;
+	eval {
+	    if (&$checker(@$_)) {
+		$self->dropping($_, $reason);
+		$drop++;
+	    }
+	};
+	push(@c, $_) unless $drop;
+    }
+    @{$self->{cc_conns}} = @c;
+}
+
+
+sub prune {
+    my $self = shift;
+    $self->drop(sub { !shift->ping }, "ping");
+}
+
+
+sub get_types {
+    my $self = shift;
+    my %t;
+    $t{$_->[1]}++ for @{$self->{cc_conns}};
+    return keys %t;
+}
+
+
+sub get_connections {
+    my($self, $type) = @_;
+    my @c;
+    for (@{$self->{cc_conns}}) {
+	push(@c, $_->[0]) if !$type || ($type && $type eq $_->[1]);
+    }
+    @c;
+}
+
+
+sub _looks_like_number {
+    $_[0] =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+LWP::ConnCache - Connection cache manager
+
+=head1 NOTE
+
+This module is experimental.  Details of its interface is likely to
+change in the future.
+
+=head1 SYNOPSIS
+
+ use LWP::ConnCache;
+ my $cache = LWP::ConnCache->new;
+ $cache->deposit($type, $key, $sock);
+ $sock = $cache->withdraw($type, $key);
+
+=head1 DESCRIPTION
+
+The C<LWP::ConnCache> class is the standard connection cache manager
+for LWP::UserAgent.
+
+The following basic methods are provided:
+
+=over
+
+=item $cache = LWP::ConnCache->new( %options )
+
+This method constructs a new C<LWP::ConnCache> object.  The only
+option currently accepted is 'total_capacity'.  If specified it
+initialize the total_capacity option.  It defaults to the value 1.
+
+=item $cache->total_capacity( [$num_connections] )
+
+Get/sets the number of connection that will be cached.  Connections
+will start to be dropped when this limit is reached.  If set to C<0>,
+then all connections are immediately dropped.  If set to C<undef>,
+then there is no limit.
+
+=item $cache->capacity($type, [$num_connections] )
+
+Get/set a limit for the number of connections of the specified type
+that can be cached.  The $type will typically be a short string like
+"http" or "ftp".
+
+=item $cache->drop( [$checker, [$reason]] )
+
+Drop connections by some criteria.  The $checker argument is a
+subroutine that is called for each connection.  If the routine returns
+a TRUE value then the connection is dropped.  The routine is called
+with ($conn, $type, $key, $deposit_time) as arguments.
+
+Shortcuts: If the $checker argument is absent (or C<undef>) all cached
+connections are dropped.  If the $checker is a number then all
+connections untouched that the given number of seconds or more are
+dropped.  If $checker is a string then all connections of the given
+type are dropped.
+
+The $reason argument is passed on to the dropped() method.
+
+=item $cache->prune
+
+Calling this method will drop all connections that are dead.  This is
+tested by calling the ping() method on the connections.  If the ping()
+method exists and returns a FALSE value, then the connection is
+dropped.
+
+=item $cache->get_types
+
+This returns all the 'type' fields used for the currently cached
+connections.
+
+=item $cache->get_connections( [$type] )
+
+This returns all connection objects of the specified type.  If no type
+is specified then all connections are returned.  In scalar context the
+number of cached connections of the specified type is returned.
+
+=back
+
+
+The following methods are called by low-level protocol modules to
+try to save away connections and to get them back.
+
+=over
+
+=item $cache->deposit($type, $key, $conn)
+
+This method adds a new connection to the cache.  As a result other
+already cached connections might be dropped.  Multiple connections with
+the same $type/$key might added.
+
+=item $conn = $cache->withdraw($type, $key)
+
+This method tries to fetch back a connection that was previously
+deposited.  If no cached connection with the specified $type/$key is
+found, then C<undef> is returned.  There is not guarantee that a
+deposited connection can be withdrawn, as the cache manger is free to
+drop connections at any time.
+
+=back
+
+The following methods are called internally.  Subclasses might want to
+override them.
+
+=over
+
+=item $conn->enforce_limits([$type])
+
+This method is called with after a new connection is added (deposited)
+in the cache or capacity limits are adjusted.  The default
+implementation drops connections until the specified capacity limits
+are not exceeded.
+
+=item $conn->dropping($conn_record, $reason)
+
+This method is called when a connection is dropped.  The record
+belonging to the dropped connection is passed as the first argument
+and a string describing the reason for the drop is passed as the
+second argument.  The default implementation makes some noise if the
+$LWP::ConnCache::DEBUG variable is set and nothing more.
+
+=back
+
+=head1 SUBCLASSING
+
+For specialized cache policy it makes sense to subclass
+C<LWP::ConnCache> and perhaps override the deposit(), enforce_limits()
+and dropping() methods.
+
+The object itself is a hash.  Keys prefixed with C<cc_> are reserved
+for the base class.
+
+=head1 SEE ALSO
+
+L<LWP::UserAgent>
+
+=head1 COPYRIGHT
+
+Copyright 2001 Gisle Aas.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.