[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/site_perl/5.10.0/i586-linux-thread-multi/DBI/ -> ProxyServer.pm (source)

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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1