[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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>
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |