home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / ProxyServer.pm < prev    next >
Encoding:
Text File  |  2003-05-14  |  26.4 KB  |  891 lines

  1. #    $Header: /home/timbo/dbi/lib/DBI/RCS/ProxyServer.pm,v 11.9 2003/05/14 11:08:17 timbo Exp $
  2. # -*- perl -*-
  3. #
  4. #   DBI::ProxyServer - a proxy server for DBI drivers
  5. #
  6. #   Copyright (c) 1997  Jochen Wiedmann
  7. #
  8. #   The DBD::Proxy module is free software; you can redistribute it and/or
  9. #   modify it under the same terms as Perl itself. In particular permission
  10. #   is granted to Tim Bunce for distributing this as a part of the DBI.
  11. #
  12. #
  13. #   Author: Jochen Wiedmann
  14. #           Am Eisteich 9
  15. #           72555 Metzingen
  16. #           Germany
  17. #
  18. #           Email: joe@ispsoft.de
  19. #           Phone: +49 7123 14881
  20. #
  21. #
  22. ##############################################################################
  23.  
  24.  
  25. require 5.004;
  26. use strict;
  27.  
  28. use RPC::PlServer 0.2001;
  29. # require DBI; # deferred till AcceptVersion() to aid threading
  30. require Config;
  31.  
  32.  
  33. package DBI::ProxyServer;
  34.  
  35.  
  36. my $haveFileSpec = eval { require File::Spec };
  37. my $tmpDir = $haveFileSpec ? File::Spec->tmpdir() :
  38.     ($ENV{'TMP'} || $ENV{'TEMP'} || '/tmp');
  39. my $defaultPidFile = $haveFileSpec ?
  40.     File::Spec->catdir($tmpDir, "dbiproxy.pid") : "/tmp/dbiproxy.pid";
  41.  
  42.  
  43. ############################################################################
  44. #
  45. #   Constants
  46. #
  47. ############################################################################
  48.  
  49. use vars qw($VERSION @ISA);
  50.  
  51. $VERSION = "0.3005";
  52. @ISA = qw(RPC::PlServer DBI);
  53.  
  54.  
  55. # Most of the options below are set to default values, we note them here
  56. # just for the sake of documentation.
  57. my %DEFAULT_SERVER_OPTIONS;
  58. {
  59.     my $o = \%DEFAULT_SERVER_OPTIONS;
  60.     $o->{'chroot'}     = undef,        # To be used in the initfile,
  61.                         # after loading the required
  62.                         # DBI drivers.
  63.     $o->{'clients'} =
  64.     [ { 'mask' => '.*',
  65.         'accept' => 1,
  66.         'cipher' => undef
  67.         }
  68.       ];
  69.     $o->{'configfile'} = '/etc/dbiproxy.conf' if -f '/etc/dbiproxy.conf';
  70.     $o->{'debug'}      = 0;
  71.     $o->{'facility'}   = 'daemon';
  72.     $o->{'group'}      = undef;
  73.     $o->{'localaddr'}  = undef;        # Bind to any local IP number
  74.     $o->{'localport'}  = undef;         # Must set port number on the
  75.                     # command line.
  76.     $o->{'logfile'}    = undef;         # Use syslog or EventLog.
  77.     $o->{'methods'}    = {
  78.     'DBI::ProxyServer' => {
  79.         'Version' => 1,
  80.         'NewHandle' => 1,
  81.         'CallMethod' => 1,
  82.         'DestroyHandle' => 1
  83.         },
  84.     'DBI::ProxyServer::db' => {
  85.         'prepare' => 1,
  86.         'commit' => 1,
  87.         'rollback' => 1,
  88.         'STORE' => 1,
  89.         'FETCH' => 1,
  90.         'func' => 1,
  91.         'quote' => 1,
  92.         'type_info_all' => 1,
  93.         'table_info' => 1,
  94.         'disconnect' => 1,
  95.         },
  96.     'DBI::ProxyServer::st' => {
  97.         'execute' => 1,
  98.         'STORE' => 1,
  99.         'FETCH' => 1,
  100.         'func' => 1,
  101.         'fetch' => 1,
  102.         'finish' => 1
  103.         }
  104.     };
  105.     if ($Config::Config{'usethreads'} eq 'define') {
  106.     $o->{'mode'} = 'threads';
  107.     } elsif ($Config::Config{'d_fork'} eq 'define') {
  108.     $o->{'mode'} = 'fork';
  109.     } else {
  110.     $o->{'mode'} = 'single';
  111.     }
  112.     $o->{'pidfile'}    = $defaultPidFile;
  113.     $o->{'user'}       = undef;
  114. };
  115.  
  116.  
  117. ############################################################################
  118. #
  119. #   Name:    Version
  120. #
  121. #   Purpose: Return version string
  122. #
  123. #   Inputs:  $class - This class
  124. #
  125. #   Result:  Version string; suitable for printing by "--version"
  126. #
  127. ############################################################################
  128.  
  129. sub Version {
  130.     my $version = $DBI::ProxyServer::VERSION;
  131.     "DBI::ProxyServer $version, Copyright (C) 1998, Jochen Wiedmann";
  132. }
  133.  
  134.  
  135. ############################################################################
  136. #
  137. #   Name:    AcceptApplication
  138. #
  139. #   Purpose: Verify DBI DSN
  140. #
  141. #   Inputs:  $self - This instance
  142. #            $dsn - DBI dsn
  143. #
  144. #   Returns: TRUE for a valid DSN, FALSE otherwise
  145. #
  146. ############################################################################
  147.  
  148. sub AcceptApplication {
  149.     my $self = shift; my $dsn = shift;
  150.     $dsn =~ /^dbi:\w+:/i;
  151. }
  152.  
  153.  
  154. ############################################################################
  155. #
  156. #   Name:    AcceptVersion
  157. #
  158. #   Purpose: Verify requested DBI version
  159. #
  160. #   Inputs:  $self - Instance
  161. #            $version - DBI version being requested
  162. #
  163. #   Returns: TRUE for ok, FALSE otherwise
  164. #
  165. ############################################################################
  166.  
  167. sub AcceptVersion {
  168.     my $self = shift; my $version = shift;
  169.     require DBI;
  170.     DBI::ProxyServer->init_rootclass();
  171.     $DBI::VERSION >= $version;
  172. }
  173.  
  174.  
  175. ############################################################################
  176. #
  177. #   Name:    AcceptUser
  178. #
  179. #   Purpose: Verify user and password by connecting to the client and
  180. #            creating a database connection
  181. #
  182. #   Inputs:  $self - Instance
  183. #            $user - User name
  184. #            $password - Password
  185. #
  186. ############################################################################
  187.  
  188. sub AcceptUser {
  189.     my $self = shift; my $user = shift; my $password = shift;
  190.     return 0 if (!$self->SUPER::AcceptUser($user, $password));
  191.     my $dsn = $self->{'application'};
  192.     $self->Debug("Connecting to $dsn as $user");
  193.     local $ENV{DBI_AUTOPROXY} = ''; # :-)
  194.     $self->{'dbh'} = eval {
  195.         DBI::ProxyServer->connect($dsn, $user, $password,
  196.                   { 'PrintError' => 0, 
  197.                     'Warn' => 0,
  198.                     'RaiseError' => 1,
  199.                     'HandleError' => sub {
  200.                         my $err = $_[1]->err;
  201.                     my $state = $_[1]->state || '';
  202.                     $_[0] .= " [err=$err,state=$state]";
  203.                     return 0;
  204.                     } })
  205.     };
  206.     if ($@) {
  207.     $self->Error("Error while connecting to $dsn as $user: $@");
  208.     return 0;
  209.     }
  210.     [1, $self->StoreHandle($self->{'dbh'}) ];
  211. }
  212.  
  213.  
  214. sub CallMethod {
  215.     my $server = shift;
  216.     my $dbh = $server->{'dbh'};
  217.     # We could store the private_server attribute permanently in
  218.     # $dbh. However, we'd have a reference loop in that case and
  219.     # I would be concerned about garbage collection. :-(
  220.     $dbh->{'private_server'} = $server;
  221.     $server->Debug("CallMethod: => " . join(",", @_));
  222.     my @result = eval { $server->SUPER::CallMethod(@_) };
  223.     my $msg = $@;
  224.     undef $dbh->{'private_server'};
  225.     if ($msg) {
  226.     $server->Debug("CallMethod died with: $@");
  227.     die $msg;
  228.     } else {
  229.     $server->Debug("CallMethod: <= " . join(",", @result));
  230.     }
  231.     @result;
  232. }
  233.  
  234.  
  235. sub main {
  236.     my $server = DBI::ProxyServer->new(\%DEFAULT_SERVER_OPTIONS, \@_);
  237.     $server->Bind();
  238. }
  239.  
  240.  
  241. ############################################################################
  242. #
  243. #   The DBI part of the proxyserver is implemented as a DBI subclass.
  244. #   Thus we can reuse some of the DBI methods and overwrite only
  245. #   those that need additional handling.
  246. #
  247. ############################################################################
  248.  
  249. package DBI::ProxyServer::dr;
  250.  
  251. @DBI::ProxyServer::dr::ISA = qw(DBI::dr);
  252.  
  253.  
  254. package DBI::ProxyServer::db;
  255.  
  256. @DBI::ProxyServer::db::ISA = qw(DBI::db);
  257.  
  258. sub prepare {
  259.     my($dbh, $statement, $attr, $params, $proto_ver) = @_;
  260.     my $server = $dbh->{'private_server'};
  261.     if (my $client = $server->{'client'}) {
  262.     if ($client->{'sql'}) {
  263.         if ($statement =~ /^\s*(\S+)/) {
  264.         my $st = $1;
  265.         if (!($statement = $client->{'sql'}->{$st})) {
  266.             die "Unknown SQL query: $st";
  267.         }
  268.         } else {
  269.         die "Cannot parse restricted SQL statement: $statement";
  270.         }
  271.     }
  272.     }
  273.     my $sth = $dbh->SUPER::prepare($statement, $attr);
  274.     my $handle = $server->StoreHandle($sth);
  275.  
  276.     if ( $proto_ver and $proto_ver > 1 ) {
  277.       $sth->{private_proxyserver_described} = 0;
  278.       return $handle;
  279.  
  280.     } else {
  281.       # The difference between the usual prepare and ours is that we implement
  282.       # a combined prepare/execute. The DBD::Proxy driver doesn't call us for
  283.       # prepare. Only if an execute happens, then we are called with method
  284.       # "prepare". Further execute's are called as "execute".
  285.       my @result = $sth->execute($params);
  286.       my ($NAME, $TYPE);
  287.       my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
  288.       if ($NUM_OF_FIELDS) {    # is a SELECT
  289.     $NAME = $sth->{NAME};
  290.     $TYPE = $sth->{TYPE};
  291.       }
  292.       ($handle, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'},
  293.        $NAME, $TYPE, @result);
  294.     }
  295. }
  296.  
  297. sub table_info {
  298.     my $dbh = shift;
  299.     my $sth = $dbh->SUPER::table_info();
  300.     my $numFields = $sth->{'NUM_OF_FIELDS'};
  301.     my $names = $sth->{'NAME'};
  302.     my $types = $sth->{'TYPE'};
  303.  
  304.     # We wouldn't need to send all the rows at this point, instead we could
  305.     # make use of $rsth->fetch() on the client as usual.
  306.     # The problem is that some drivers (namely DBD::ExampleP, DBD::mysql and
  307.     # DBD::mSQL) are returning foreign sth's here, thus an instance of
  308.     # DBI::st and not DBI::ProxyServer::st. We could fix this by permitting
  309.     # the client to execute method DBI::st, but I don't like this.
  310.     my @rows;
  311.     while (my ($row) = $sth->fetch()) {
  312.         last unless defined $row;
  313.     push(@rows, [@$row]);
  314.     }
  315.     ($numFields, $names, $types, @rows);
  316. }
  317.  
  318.  
  319. package DBI::ProxyServer::st;
  320.  
  321. @DBI::ProxyServer::st::ISA = qw(DBI::st);
  322.  
  323. sub execute {
  324.     my $sth = shift; my $params = shift; my $proto_ver = shift;
  325.     my @outParams;
  326.     if ($params) {
  327.     for (my $i = 0;  $i < @$params;) {
  328.         my $param = $params->[$i++];
  329.         if (!ref($param)) {
  330.         $sth->bind_param($i, $param);
  331.         }
  332.         else {    
  333.         if (!ref(@$param[0])) {#It's not a reference
  334.             $sth->bind_param($i, @$param);
  335.         }
  336.         else {
  337.             $sth->bind_param_inout($i, @$param);
  338.             my $ref = shift @$param;
  339.             push(@outParams, $ref);
  340.         }
  341.         }
  342.     }
  343.     }
  344.     my $rows = $sth->SUPER::execute();
  345.     if ( $proto_ver and $proto_ver > 1 and not $sth->{private_proxyserver_described} ) {
  346.       my ($NAME, $TYPE);
  347.       my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
  348.       if ($NUM_OF_FIELDS) {    # is a SELECT
  349.     $NAME = $sth->{NAME};
  350.     $TYPE = $sth->{TYPE};
  351.       }
  352.       $sth->{private_proxyserver_described} = 1;
  353.       # First execution, we ship back description.
  354.       return ($rows, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'}, $NAME, $TYPE, @outParams);
  355.     }
  356.     ($rows, @outParams);
  357. }
  358.  
  359. sub fetch {
  360.     my $sth = shift; my $numRows = shift || 1;
  361.     my($ref, @rows);
  362.     while ($numRows--  &&  ($ref = $sth->SUPER::fetch())) {
  363.     push(@rows, [@$ref]);
  364.     }
  365.     @rows;
  366. }
  367.  
  368.  
  369. 1;
  370.  
  371.  
  372. __END__
  373.  
  374. =head1 NAME
  375.  
  376. DBI::ProxyServer - a server for the DBD::Proxy driver
  377.  
  378.  
  379. =head1 SYNOPSIS
  380.  
  381.     use DBI::ProxyServer;
  382.     DBI::ProxyServer::main(@ARGV);
  383.  
  384.  
  385. =head1 DESCRIPTION
  386.  
  387. DBI::Proxy Server is a module for implementing a proxy for the DBI proxy
  388. driver, DBD::Proxy. It allows access to databases over the network if the
  389. DBMS does not offer networked operations. But the proxy server might be
  390. usefull for you, even if you have a DBMS with integrated network
  391. functionality: It can be used as a DBI proxy in a firewalled environment.
  392.  
  393. DBI::ProxyServer runs as a daemon on the machine with the DBMS or on the
  394. firewall. The client connects to the agent using the DBI driver DBD::Proxy,
  395. thus in the exactly same way than using DBD::mysql, DBD::mSQL or any other
  396. DBI driver.
  397.  
  398. The agent is implemented as a RPC::PlServer application. Thus you have
  399. access to all the possibilities of this module, in particular encryption
  400. and a similar configuration file. DBI::ProxyServer adds the possibility of
  401. query restrictions: You can define a set of queries that a client may
  402. execute and restrict access to those. (Requires a DBI driver that supports
  403. parameter binding.) See L</CONFIGURATION FILE>.
  404.  
  405. The provided driver script, L<dbiproxy(1)>, may either be used as it is or
  406. used as the basis for a local version modified to meet your needs.
  407.  
  408. =head1 OPTIONS
  409.  
  410. When calling the DBI::ProxyServer::main() function, you supply an
  411. array of options. (@ARGV, the array of command line options is used,
  412. if you don't.) These options are parsed by the Getopt::Long module.
  413. The ProxyServer inherits all of RPC::PlServer's and hence Net::Daemon's
  414. options and option handling, in particular the ability to read
  415. options from either the command line or a config file. See
  416. L<RPC::PlServer(3)>. See L<Net::Daemon(3)>. Available options include
  417.  
  418. =over 4
  419.  
  420. =item I<chroot> (B<--chroot=dir>)
  421.  
  422. (UNIX only)  After doing a bind(), change root directory to the given
  423. directory by doing a chroot(). This is usefull for security, but it
  424. restricts the environment a lot. For example, you need to load DBI
  425. drivers in the config file or you have to create hard links to Unix
  426. sockets, if your drivers are using them. For example, with MySQL, a
  427. config file might contain the following lines:
  428.  
  429.     my $rootdir = '/var/dbiproxy';
  430.     my $unixsockdir = '/tmp';
  431.     my $unixsockfile = 'mysql.sock';
  432.     foreach $dir ($rootdir, "$rootdir$unixsockdir") {
  433.     mkdir 0755, $dir;
  434.     }
  435.     link("$unixsockdir/$unixsockfile",
  436.      "$rootdir$unixsockdir/$unixsockfile");
  437.     require DBD::mysql;
  438.  
  439.     {
  440.     'chroot' => $rootdir,
  441.     ...
  442.     }
  443.  
  444. If you don't know chroot(), think of an FTP server where you can see a
  445. certain directory tree only after logging in. See also the --group and
  446. --user options.
  447.  
  448. =item I<clients>
  449.  
  450. An array ref with a list of clients. Clients are hash refs, the attributes
  451. I<accept> (0 for denying access and 1 for permitting) and I<mask>, a Perl
  452. regular expression for the clients IP number or its host name. See
  453. L<"Access control"> below.
  454.  
  455. =item I<configfile> (B<--configfile=file>)
  456.  
  457. Config files are assumed to return a single hash ref that overrides the
  458. arguments of the new method. However, command line arguments in turn take
  459. precedence over the config file. See the L<"CONFIGURATION FILE"> section
  460. below for details on the config file.
  461.  
  462. =item I<debug> (B<--debug>)
  463.  
  464. Turn debugging mode on. Mainly this asserts that logging messages of
  465. level "debug" are created.
  466.  
  467. =item I<facility> (B<--facility=mode>)
  468.  
  469. (UNIX only) Facility to use for L<Sys::Syslog (3)>. The default is
  470. B<daemon>.
  471.  
  472. =item I<group> (B<--group=gid>)
  473.  
  474. After doing a bind(), change the real and effective GID to the given.
  475. This is usefull, if you want your server to bind to a privileged port
  476. (<1024), but don't want the server to execute as root. See also
  477. the --user option.
  478.  
  479. GID's can be passed as group names or numeric values.
  480.  
  481. =item I<localaddr> (B<--localaddr=ip>)
  482.  
  483. By default a daemon is listening to any IP number that a machine
  484. has. This attribute allows to restrict the server to the given
  485. IP number.
  486.  
  487. =item I<localport> (B<--localport=port>)
  488.  
  489. This attribute sets the port on which the daemon is listening. It
  490. must be given somehow, as there's no default.
  491.  
  492. =item I<logfile> (B<--logfile=file>)
  493.  
  494. Be default logging messages will be written to the syslog (Unix) or
  495. to the event log (Windows NT). On other operating systems you need to
  496. specify a log file. The special value "STDERR" forces logging to
  497. stderr. See L<Net::Daemon::Log(3)> for details.
  498.  
  499. =item I<mode> (B<--mode=modename>)
  500.  
  501. The server can run in three different modes, depending on the environment.
  502.  
  503. If you are running Perl 5.005 and did compile it for threads, then the
  504. server will create a new thread for each connection. The thread will
  505. execute the server's Run() method and then terminate. This mode is the
  506. default, you can force it with "--mode=threads".
  507.  
  508. If threads are not available, but you have a working fork(), then the
  509. server will behave similar by creating a new process for each connection.
  510. This mode will be used automatically in the absence of threads or if
  511. you use the "--mode=fork" option.
  512.  
  513. Finally there's a single-connection mode: If the server has accepted a
  514. connection, he will enter the Run() method. No other connections are
  515. accepted until the Run() method returns (if the client disconnects).
  516. This operation mode is usefull if you have neither threads nor fork(),
  517. for example on the Macintosh. For debugging purposes you can force this
  518. mode with "--mode=single".
  519.  
  520. =item I<pidfile> (B<--pidfile=file>)
  521.  
  522. (UNIX only) If this option is present, a PID file will be created at the
  523. given location.
  524.  
  525. =item I<user> (B<--user=uid>)
  526.  
  527. After doing a bind(), change the real and effective UID to the given.
  528. This is usefull, if you want your server to bind to a privileged port
  529. (<1024), but don't want the server to execute as root. See also
  530. the --group and the --chroot options.
  531.  
  532. UID's can be passed as group names or numeric values.
  533.  
  534. =item I<version> (B<--version>)
  535.  
  536. Supresses startup of the server; instead the version string will
  537. be printed and the program exits immediately.
  538.  
  539. =back
  540.  
  541.  
  542. =head1 CONFIGURATION FILE
  543.  
  544. The configuration file is just that of I<RPC::PlServer> or I<Net::Daemon>
  545. with some additional attributes in the client list.
  546.  
  547. The config file is a Perl script. At the top of the file you may include
  548. arbitraty Perl source, for example load drivers at the start (usefull
  549. to enhance performance), prepare a chroot environment and so on.
  550.  
  551. The important thing is that you finally return a hash ref of option
  552. name/value pairs. The possible options are listed above.
  553.  
  554. All possibilities of Net::Daemon and RPC::PlServer apply, in particular
  555.  
  556. =over 4
  557.  
  558. =item Host and/or User dependent access control
  559.  
  560. =item Host and/or User dependent encryption
  561.  
  562. =item Changing UID and/or GID after binding to the port
  563.  
  564. =item Running in a chroot() environment
  565.  
  566. =back
  567.  
  568. Additionally the server offers you query restrictions. Suggest the
  569. following client list:
  570.  
  571.     'clients' => [
  572.     { 'mask' => '^admin\.company\.com$',
  573.           'accept' => 1,
  574.           'users' => [ 'root', 'wwwrun' ],
  575.         },
  576.         {
  577.       'mask' => '^admin\.company\.com$',
  578.           'accept' => 1,
  579.           'users' => [ 'root', 'wwwrun' ],
  580.           'sql' => {
  581.                'select' => 'SELECT * FROM foo',
  582.                'insert' => 'INSERT INTO foo VALUES (?, ?, ?)'
  583.                }
  584.         }
  585.  
  586. then only the users root and wwwrun may connect from admin.company.com,
  587. executing arbitrary queries, but only wwwrun may connect from other
  588. hosts and is restricted to
  589.  
  590.     $sth->prepare("select");
  591.  
  592. or
  593.  
  594.     $sth->prepare("insert");
  595.  
  596. which in fact are "SELECT * FROM foo" or "INSERT INTO foo VALUES (?, ?, ?)".
  597.  
  598.  
  599. =head1 Proxyserver Configuration file (bigger example)
  600.  
  601. This section tells you how to restrict a DBI-Proxy: Not every user from
  602. every workstation shall be able to execute every query.
  603.  
  604. There is a perl program "dbiproxy" which runs on a machine which is able
  605. to connect to all the databases we wish to reach. All Perl-DBD-drivers must
  606. be installed on this machine. You can also reach databases for which drivers 
  607. are not available on the machine where you run the programm querying the 
  608. database, e.g. ask MS-Access-database from Linux.
  609.  
  610. Create a configuration file "proxy_oracle.cfg" at the dbproxy-server:
  611.  
  612.     {
  613.     # This shall run in a shell or a DOS-window 
  614.     # facility => 'daemon',
  615.     pidfile => 'dbiproxy.pid',
  616.     logfile => 1,
  617.     debug => 0,
  618.     mode => 'single',
  619.     localport => '12400',
  620.  
  621.     # Access control, the first match in this list wins!
  622.     # So the order is important
  623.     clients => [
  624.         # hint to organize:
  625.         # the most specialized rules for single machines/users are 1st
  626.         # then the denying rules
  627.         # the the rules about whole networks
  628.         
  629.         # rule: internal_webserver
  630.         # desc: to get statistical information
  631.         {
  632.             # this IP-address only is meant
  633.             mask => '^10\.95\.81\.243$',
  634.             # accept (not defer) connections like this
  635.             accept => 1,
  636.             # only users from this list 
  637.             # are allowed to log on
  638.             users => [ 'informationdesk' ],
  639.             # only this statistical query is allowed
  640.             # to get results for a web-query
  641.             sql => {
  642.                 alive => 'select count(*) from dual',
  643.                 statistic_area => 'select count(*) from e01admin.e01e203 where geb_bezei like ?',
  644.             }
  645.         },
  646.         
  647.         # rule: internal_bad_guy_1
  648.         {
  649.             mask => '^10\.95\.81\.1$',
  650.             accept => 0,
  651.         },
  652.  
  653.         # rule: employee_workplace
  654.         # desc: get detailled informations
  655.         {
  656.             # any IP-address is meant here
  657.             mask => '^10\.95\.81\.(\d+)$',
  658.             # accept (not defer) connections like this
  659.             accept => 1,
  660.             # only users from this list 
  661.             # are allowed to log on
  662.             users => [ 'informationdesk', 'lippmann' ],
  663.             # all these queries are allowed:
  664.             sql => {
  665.                 search_city => 'select ort_nr, plz, ort from e01admin.e01e200 where plz like ?',
  666.                 search_area => 'select gebiettyp, geb_bezei from e01admin.e01e203 where geb_bezei like ? or geb_bezei like ?',
  667.             }
  668.         },
  669.  
  670.         # rule: internal_bad_guy_2 
  671.         # This does NOT work, because rule "employee_workplace" hits
  672.         # with its ip-address-mask of the whole network
  673.         {
  674.             # don't accept connection from this ip-address
  675.             mask => '^10\.95\.81\.5$',
  676.             accept => 0,
  677.         }
  678.     ]
  679.     }
  680.  
  681. Start the proxyserver like this:
  682.  
  683.     rem well-set Oracle_home needed for Oracle
  684.     set ORACLE_HOME=d:\oracle\ora81
  685.     dbiproxy --configfile proxy_oracle.cfg
  686.  
  687.  
  688. =head2 Testing the connection from a remote machine
  689.  
  690. Call a programm "dbish" from your commandline. I take the machine from rule "internal_webserver"
  691.  
  692.     dbish "dbi:Proxy:hostname=oracle.zdf;port=12400;dsn=dbi:Oracle:e01" informationdesk xxx
  693.  
  694. There will be a shell-prompt:
  695.  
  696.     informationdesk@dbi...> alive
  697.  
  698.     Current statement buffer (enter '/'...):
  699.     alive
  700.  
  701.     informationdesk@dbi...> /
  702.     COUNT(*)
  703.     '1'
  704.     [1 rows of 1 fields returned]
  705.  
  706.  
  707. =head2 Testing the connection with a perl-script
  708.  
  709. Create a perl-script like this:
  710.  
  711.     # file: oratest.pl
  712.     # call me like this: perl oratest.pl user password
  713.  
  714.     use strict;
  715.     use DBI;
  716.  
  717.     my $user = shift || die "Usage: $0 user password";
  718.     my $pass = shift || die "Usage: $0 user password";
  719.     my $config = {
  720.         dsn_at_proxy => "dbi:Oracle:e01",
  721.         proxy => "hostname=oechsle.zdf;port=12400",
  722.     };
  723.     my $dsn = sprintf "dbi:Proxy:%s;dsn=%s",
  724.         $config->{proxy},
  725.         $config->{dsn_at_proxy};
  726.  
  727.     my $dbh = DBI->connect( $dsn, $user, $pass )
  728.         || die "connect did not work: $DBI::errstr";
  729.  
  730.     my $sql = "search_city";
  731.     printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
  732.     my $cur = $dbh->prepare($sql);
  733.     $cur->bind_param(1,'905%');
  734.     &show_result ($cur);
  735.  
  736.     my $sql = "search_area";
  737.     printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
  738.     my $cur = $dbh->prepare($sql);
  739.     $cur->bind_param(1,'Pfarr%');
  740.     $cur->bind_param(2,'Bronnamberg%');
  741.     &show_result ($cur);
  742.  
  743.     my $sql = "statistic_area";
  744.     printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
  745.     my $cur = $dbh->prepare($sql);
  746.     $cur->bind_param(1,'Pfarr%');
  747.     &show_result ($cur);
  748.  
  749.     $dbh->disconnect;
  750.     exit;
  751.  
  752.  
  753.     sub show_result {
  754.         my $cur = shift;
  755.         unless ($cur->execute()) {
  756.             print "Could not execute\n"; 
  757.             return; 
  758.         }
  759.  
  760.         my $rownum = 0;
  761.         while (my @row = $cur->fetchrow_array()) {
  762.             printf "Row is: %s\n", join(", ",@row);
  763.             if ($rownum++ > 5) {
  764.                 print "... and so on\n";
  765.                 last;
  766.             }    
  767.         }
  768.         $cur->finish;
  769.     }
  770.  
  771. The result
  772.  
  773.     C:\>perl oratest.pl informationdesk xxx
  774.     ========================================
  775.     search_city
  776.     ========================================
  777.     Row is: 3322, 9050, Chemnitz
  778.     Row is: 3678, 9051, Chemnitz
  779.     Row is: 10447, 9051, Chemnitz
  780.     Row is: 12128, 9051, Chemnitz
  781.     Row is: 10954, 90513, Zirndorf
  782.     Row is: 5808, 90513, Zirndorf
  783.     Row is: 5715, 90513, Zirndorf
  784.     ... and so on
  785.     ========================================
  786.     search_area
  787.     ========================================
  788.     Row is: 101, Bronnamberg
  789.     Row is: 400, Pfarramt Zirndorf
  790.     Row is: 400, Pfarramt Rosstal
  791.     Row is: 400, Pfarramt Oberasbach
  792.     Row is: 401, Pfarramt Zirndorf
  793.     Row is: 401, Pfarramt Rosstal
  794.     ========================================
  795.     statistic_area
  796.     ========================================
  797.     DBD::Proxy::st execute failed: Server returned error: Failed to execute method CallMethod: Unknown SQL query: statistic_area at E:/Perl/site/lib/DBI/ProxyServer.pm line 258.
  798.     Could not execute
  799.  
  800.  
  801. =head2 How the configuration works
  802.  
  803. The most important section to control access to your dbi-proxy is "client=>"
  804. in the file "proxy_oracle.cfg":
  805.  
  806. Controlling which person at which machine is allowed to access
  807.  
  808. =over 4
  809.  
  810. =item * "mask" is a perl regular expression against the plain ip-address of the machine which wishes to connect _or_ the reverse-lookup from a nameserver.
  811.  
  812. =item * "accept" tells the dbiproxy-server wether ip-adresse like in "mask" are allowed to connect or not (0/1)
  813.  
  814. =item * "users" is a reference to a list of usernames which must be matched, this is NOT a regular expression.
  815.  
  816. =back
  817.  
  818. Controlling which SQL-statements are allowed
  819.  
  820. You can put every SQL-statement you like in simply ommiting "sql => ...", but the more important thing is to restrict the connection so that only allowed queries are possible.
  821.  
  822. If you include an sql-section in your config-file like this:
  823.  
  824.     sql => {
  825.         alive => 'select count(*) from dual',
  826.         statistic_area => 'select count(*) from e01admin.e01e203 where geb_bezei like ?',
  827.     }
  828.  
  829. The user is allowed to put two queries against the dbi-proxy. The queries are _not_ "select count(*)...", the queries are "alive" and "statistic_area"! These keywords are replaced by the real query. So you can run a query for "alive":
  830.  
  831.     my $sql = "alive";
  832.     my $cur = $dbh->prepare($sql);
  833.     ...
  834.  
  835. The flexibility is that you can put parameters in the where-part of the query so the query are not static. Simply replace a value in the where-part of the query through a question mark and bind it as a parameter to the query. 
  836.  
  837.     my $sql = "statistic_area";
  838.     my $cur = $dbh->prepare($sql);
  839.     $cur->bind_param(1,'905%');
  840.     # A second parameter would be called like this:
  841.     # $cur->bind_param(2,'98%');
  842.  
  843. The result is this query:
  844.  
  845.     select count(*) from e01admin.e01e203 
  846.     where geb_bezei like '905%'
  847.  
  848. Don't try to put parameters into the sql-query like this:
  849.  
  850.     # Does not work like you think.
  851.     # Only the first word of the query is parsed,
  852.     # so it's changed to "statistic_area", the rest is omitted.
  853.     # You _have_ to work with $cur->bind_param.
  854.     my $sql = "statistic_area 905%";
  855.     my $cur = $dbh->prepare($sql);
  856.     ...
  857.  
  858.  
  859. =head2 Problems
  860.  
  861. =over 4
  862.  
  863. =item * I don't know how to restrict users to special databases.
  864.  
  865. =item * I don't know how to pass query-parameters via dbish
  866.  
  867. =back
  868.  
  869.  
  870. =head1 AUTHOR
  871.  
  872.     Copyright (c) 1997    Jochen Wiedmann
  873.                           Am Eisteich 9
  874.                           72555 Metzingen
  875.                           Germany
  876.  
  877.                           Email: joe@ispsoft.de
  878.                           Phone: +49 7123 14881
  879.  
  880. The DBI::ProxyServer module is free software; you can redistribute it
  881. and/or modify it under the same terms as Perl itself. In particular
  882. permission is granted to Tim Bunce for distributing this as a part of
  883. the DBI.
  884.  
  885.  
  886. =head1 SEE ALSO
  887.  
  888. L<dbiproxy(1)>, L<DBD::Proxy(3)>, L<DBI(3)>, L<RPC::PlServer(3)>,
  889. L<RPC::PlClient(3)>, L<Net::Daemon(3)>, L<Net::Daemon::Log(3)>,
  890. L<Sys::Syslog(3)>, L<Win32::EventLog(3)>, L<syslog(2)>
  891.