[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / DBI / ProxyServer.pm

# -*- perl -*-
#
#   DBI::ProxyServer - a proxy server for DBI drivers
#
#   Copyright (c) 1997  Jochen Wiedmann
#
#   The DBD::Proxy module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself. In particular permission
#   is granted to Tim Bunce for distributing this as a part of the DBI.
#
#
#   Author: Jochen Wiedmann
#           Am Eisteich 9
#           72555 Metzingen
#           Germany
#
#           Email: joe@ispsoft.de
#           Phone: +49 7123 14881
#
#

require 5.004;
use strict;

use RPC::PlServer 0.2001;
require DBI;
require Config;


package DBI::ProxyServer;


my $haveFileSpec = eval { require File::Spec };
my $tmpDir = $haveFileSpec ? File::Spec->tmpdir() :
    ($ENV{'TMP'} || $ENV{'TEMP'} || '/tmp');
my $defaultPidFile = $haveFileSpec ?
    File::Spec->catdir($tmpDir, "dbiproxy.pid") : "/tmp/dbiproxy.pid";


############################################################################
#
#   Constants
#
############################################################################

use vars qw($VERSION @ISA);

$VERSION = "0.2004";
@ISA = qw(RPC::PlServer DBI);


# Most of the options below are set to default values, we note them here
# just for the sake of documentation.
my %DEFAULT_SERVER_OPTIONS;
{
    my $o = \%DEFAULT_SERVER_OPTIONS;
    $o->{'chroot'}     = undef,		# To be used in the initfile,
    					# after loading the required
    					# DBI drivers.
    $o->{'clients'} =
	[ { 'mask' => '.*',
	    'accept' => 1,
	    'cipher' => undef
	    }
	  ];
    $o->{'configfile'} = '/etc/dbiproxy.conf' if -f '/etc/dbiproxy.conf';
    $o->{'debug'}      = 0;
    $o->{'facility'}   = 'daemon';
    $o->{'group'}      = undef;
    $o->{'localaddr'}  = undef;		# Bind to any local IP number
    $o->{'localport'}  = undef;         # Must set port number on the
					# command line.
    $o->{'logfile'}    = undef;         # Use syslog or EventLog.
    $o->{'methods'}    = {
	'DBI::ProxyServer' => {
	    'NewHandle' => 1,
	    'CallMethod' => 1,
	    'DestroyHandle' => 1
	    },
	'DBI::ProxyServer::db' => {
	    'prepare' => 1,
	    'commit' => 1,
	    'rollback' => 1,
	    'STORE' => 1,
	    'FETCH' => 1,
	    'func' => 1,
	    'quote' => 1,
	    'type_info_all' => 1,
            'table_info' => 1
	    },
	'DBI::ProxyServer::st' => {
	    'execute' => 1,
	    'STORE' => 1,
	    'FETCH' => 1,
	    'func' => 1,
	    'fetch' => 1,
	    'finish' => 1
	    }
    };
    if ($Config::Config{'usethreads'} eq 'define') {
	$o->{'mode'} = 'threads';
    } elsif ($Config::Config{'d_fork'} eq 'define') {
	$o->{'mode'} = 'fork';
    } else {
	$o->{'mode'} = 'single';
    }
    $o->{'pidfile'}    = $defaultPidFile;
    $o->{'user'}       = undef;
};


############################################################################
#
#   Name:    Version
#
#   Purpose: Return version string
#
#   Inputs:  $class - This class
#
#   Result:  Version string; suitable for printing by "--version"
#
############################################################################

sub Version {
    my $version = $DBI::ProxyServer::VERSION;
    "DBI::ProxyServer $version, Copyright (C) 1998, Jochen Wiedmann";
}


############################################################################
#
#   Name:    AcceptApplication
#
#   Purpose: Verify DBI DSN
#
#   Inputs:  $self - This instance
#            $dsn - DBI dsn
#
#   Returns: TRUE for a valid DSN, FALSE otherwise
#
############################################################################

sub AcceptApplication {
    my $self = shift; my $dsn = shift;
    $dsn =~ /^dbi:\w+:/i;
}


############################################################################
#
#   Name:    AcceptVersion
#
#   Purpose: Verify requested DBI version
#
#   Inputs:  $self - Instance
#            $version - DBI version being requested
#
#   Returns: TRUE for ok, FALSE otherwise
#
############################################################################

sub AcceptVersion {
    my $self = shift; my $version = shift;
    $DBI::VERSION >= $version;
}


############################################################################
#
#   Name:    AcceptUser
#
#   Purpose: Verify user and password by connecting to the client and
#            creating a database connection
#
#   Inputs:  $self - Instance
#            $user - User name
#            $password - Password
#
############################################################################

sub AcceptUser {
    my $self = shift; my $user = shift; my $password = shift;
    return 0 if (!$self->SUPER::AcceptUser($user, $password));
    my $dsn = $self->{'application'};
    $self->Debug("Connecting to $dsn as $user");
    local $ENV{DBI_AUTOPROXY} = ''; # :-)
    $self->{'dbh'} = eval {
	DBI::ProxyServer->connect($dsn, $user, $password,
				  { 'PrintError' => 0, 'Warn' => 0,
				    RaiseError => 1 })
    };
    if ($@) {
	$self->Error("Error while connecting to $dsn as $user: $@");
	return 0;
    }
    [1, $self->StoreHandle($self->{'dbh'}) ];
}


sub CallMethod {
    my $server = shift;
    my $dbh = $server->{'dbh'};
    # We could store the private_server attribute permanently in
    # $dbh. However, we'd have a reference loop in that case and
    # I would be concerned about garbage collection. :-(
    $dbh->{'private_server'} = $server;
    $server->Debug("CallMethod: => " . join(",", @_));
    my @result = eval { $server->SUPER::CallMethod(@_) };
    undef $dbh->{'private_server'};
    if (my $msg = $@) {
	$server->Error($msg);
	die $msg;
    } else {
	$server->Debug("CallMethod: <= " . join(",", @result));
    }
    @result;
}


sub main {
    my $server = DBI::ProxyServer->new(\%DEFAULT_SERVER_OPTIONS, \@_);
    $server->Bind();
}


############################################################################
#
#   The DBI part of the proxyserver is implemented as a DBI subclass.
#   Thus we can reuse some of the DBI methods and overwrite only
#   those that need additional handling.
#
############################################################################

DBI::ProxyServer->init_rootclass();

package DBI::ProxyServer::dr;

@DBI::ProxyServer::dr::ISA = qw(DBI::dr);


package DBI::ProxyServer::db;

@DBI::ProxyServer::db::ISA = qw(DBI::db);

sub prepare {
    my($dbh, $statement, $attr, $params) = @_;
    my $server = $dbh->{'private_server'};
    if (my $client = $server->{'client'}) {
	if ($client->{'sql'}) {
	    if ($statement =~ /^\s*(\S+)/) {
		my $st = $1;
		if (!($statement = $client->{'sql'}->{$st})) {
		    die "Unknown SQL query: $st";
		}
	    } else {
		die "Cannot parse restricted SQL statement: $statement";
	    }
	}
    }

    # The difference between the usual prepare and ours is that we implement
    # a combined prepare/execute. The DBD::Proxy driver doesn't call us for
    # prepare. Only if an execute happens, then we are called with method
    # "prepare". Further execute's are called as "execute".
    my $sth = $dbh->SUPER::prepare($statement, $attr);
    my @result = $sth->execute($params);
    my $handle = $server->StoreHandle($sth);
    my ($NAME, $TYPE);
    my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
    if ($NUM_OF_FIELDS) {	# is a SELECT
	$NAME = $sth->{NAME};
	$TYPE = $sth->{TYPE};
    }
    ($handle, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'},
     $NAME, $TYPE, @result);
}

sub table_info {
    my $dbh = shift;
    my $sth = $dbh->SUPER::table_info();
    my $numFields = $sth->{'NUM_OF_FIELDS'};
    my $names = $sth->{'NAME'};
    my $types = $sth->{'TYPE'};

    # We wouldn't need to send all the rows at this point, instead we could
    # make use of $rsth->fetch() on the client as usual.
    # The problem is that some drivers (namely DBD::ExampleP, DBD::mysql and
    # DBD::mSQL) are returning foreign sth's here, thus an instance of
    # DBI::st and not DBI::ProxyServer::st. We could fix this by permitting
    # the client to execute method DBI::st, but I don't like this.
    my @rows;
    while (my $row = $sth->fetchrow_arrayref()) {
	push(@rows, [@$row]);
    }
    ($numFields, $names, $types, @rows);
}


package DBI::ProxyServer::st;

@DBI::ProxyServer::st::ISA = qw(DBI::st);

sub execute {
    my $sth = shift; my $params = shift;
    my @outParams;

    if ($params) {
	for (my $i = 0;  $i < @$params;) {
	    my $param = $params->[$i++];
	    if (!ref($param)) {
		$sth->bind_param($i, $param);
	    } else {
		# value, type => bind_param,
		# value, type, maxlen => bind_param_inout
		if (@$param <= 2) {
		    $sth->bind_param($i, @$param);
		} else {
		    $sth->bind_param_inout($i, @$param);
		    my $ref = shift @$param;
		    push(@outParams, $ref);
		}
	    }
	}
    }

    my $rows = $sth->SUPER::execute();
    ($rows, @outParams);
}

sub fetch {
    my $sth = shift; my $numRows = shift || 1;
    my($ref, @rows);
    while ($numRows--  &&  ($ref = $sth->fetchrow_arrayref())) {
	push(@rows, [@$ref]);
    }
    @rows;
}


1;


__END__

=head1 NAME

DBI::ProxyServer - a server for the DBD::Proxy driver


=head1 SYNOPSIS

    use DBI::ProxyServer;
    DBI::ProxyServer::main(@ARGV);


=head1 DESCRIPTION

DBI::Proxy Server is a module for implementing a proxy for the DBI proxy
driver, DBD::Proxy. It allows access to databases over the network if the
DBMS does not offer networked operations. But the proxy server might be
usefull for you, even if you have a DBMS with integrated network
functionality: It can be used as a DBI proxy in a firewalled environment.

DBI::ProxyServer runs as a daemon on the machine with the DBMS or on the
firewall. The client connects to the agent using the DBI driver DBD::Proxy,
thus in the exactly same way than using DBD::mysql, DBD::mSQL or any other
DBI driver.

The agent is implemented as a RPC::PlServer application. Thus you have
access to all the possibilities of this module, in particular encryption
and a similar configuration file. DBI::ProxyServer adds the possibility of
query restrictions: You can define a set of queries that a client may
execute and restrict access to those. (Requires a DBI driver that supports
parameter binding.) See L</CONFIGURATION FILE>.


=head1 OPTIONS

When calling the DBI::ProxyServer::main() function, you supply an
array of options. (@ARGV, the array of command line options is used,
if you don't.) These options are parsed by the Getopt::Long module.
The ProxyServer inherits all of RPC::PlServer's and hence Net::Daemon's
options and option handling, in particular the ability to read
options from either the command line or a config file. See
L<RPC::PlServer(3)>. See L<Net::Daemon(3)>. Available options include

=over 4

=item I<chroot> (B<--chroot=dir>)

(UNIX only)  After doing a bind(), change root directory to the given
directory by doing a chroot(). This is usefull for security, but it
restricts the environment a lot. For example, you need to load DBI
drivers in the config file or you have to create hard links to Unix
sockets, if your drivers are using them. For example, with MySQL, a
config file might contain the following lines:

    my $rootdir = '/var/dbiproxy';
    my $unixsockdir = '/tmp';
    my $unixsockfile = 'mysql.sock';
    foreach $dir ($rootdir, "$rootdir$unixsockdir") {
	mkdir 0755, $dir;
    }
    link("$unixsockdir/$unixsockfile",
	 "$rootdir$unixsockdir/$unixsockfile");
    require DBD::mysql;

    {
	'chroot' => $rootdir,
	...
    }

If you don't know chroot(), think of an FTP server where you can see a
certain directory tree only after logging in. See also the --group and
--user options.

=item I<clients>

An array ref with a list of clients. Clients are hash refs, the attributes
I<accept> (0 for denying access and 1 for permitting) and I<mask>, a Perl
regular expression for the clients IP number or its host name. See
L<"Access control"> below.

=item I<configfile> (B<--configfile=file>)

Config files are assumed to return a single hash ref that overrides the
arguments of the new method. However, command line arguments in turn take
precedence over the config file. See the L<"CONFIGURATION FILE"> section
below for details on the config file.

=item I<debug> (B<--debug>)

Turn debugging mode on. Mainly this asserts that logging messages of
level "debug" are created.

=item I<facility> (B<--facility=mode>)

(UNIX only) Facility to use for L<Sys::Syslog (3)>. The default is
B<daemon>.

=item I<group> (B<--group=gid>)

After doing a bind(), change the real and effective GID to the given.
This is usefull, if you want your server to bind to a privileged port
(<1024), but don't want the server to execute as root. See also
the --user option.

GID's can be passed as group names or numeric values.

=item I<localaddr> (B<--localaddr=ip>)

By default a daemon is listening to any IP number that a machine
has. This attribute allows to restrict the server to the given
IP number.

=item I<localport> (B<--localport=port>)

This attribute sets the port on which the daemon is listening. It
must be given somehow, as there's no default.

=item I<logfile> (B<--logfile=file>)

Be default logging messages will be written to the syslog (Unix) or
to the event log (Windows NT). On other operating systems you need to
specify a log file. The special value "STDERR" forces logging to
stderr. See L<Net::Daemon::Log(3)> for details.

=item I<mode> (B<--mode=modename>)

The server can run in three different modes, depending on the environment.

If you are running Perl 5.005 and did compile it for threads, then the
server will create a new thread for each connection. The thread will
execute the server's Run() method and then terminate. This mode is the
default, you can force it with "--mode=threads".

If threads are not available, but you have a working fork(), then the
server will behave similar by creating a new process for each connection.
This mode will be used automatically in the absence of threads or if
you use the "--mode=fork" option.

Finally there's a single-connection mode: If the server has accepted a
connection, he will enter the Run() method. No other connections are
accepted until the Run() method returns (if the client disconnects).
This operation mode is usefull if you have neither threads nor fork(),
for example on the Macintosh. For debugging purposes you can force this
mode with "--mode=single".

=item I<pidfile> (B<--pidfile=file>)

(UNIX only) If this option is present, a PID file will be created at the
given location.

=item I<user> (B<--user=uid>)

After doing a bind(), change the real and effective UID to the given.
This is usefull, if you want your server to bind to a privileged port
(<1024), but don't want the server to execute as root. See also
the --group and the --chroot options.

UID's can be passed as group names or numeric values.

=item I<version> (B<--version>)

Supresses startup of the server; instead the version string will
be printed and the program exits immediately.

=back


=head1 CONFIGURATION FILE

The configuration file is just that of I<RPC::PlServer> or I<Net::Daemon>
with some additional attributes in the client list.

The config file is a Perl script. At the top of the file you may include
arbitraty Perl source, for example load drivers at the start (usefull
to enhance performance), prepare a chroot environment and so on.

The important thing is that you finally return a hash ref of option
name/value pairs. The possible options are listed above.

All possibilities of Net::Daemon and RPC::PlServer apply, in particular

=over 4

=item Host and/or User dependent access control

=item Host and/or User dependent encryption

=item Changing UID and/or GID after binding to the port

=item Running in a chroot() environment

=back

Additionally the server offers you query restrictions. Suggest the
following client list:

    'clients' => [
	{ 'mask' => '^admin\.company\.com$',
          'accept' => 1,
          'users' => [ 'root', 'wwwrun' ],
        },
        {
	  'mask' => '^admin\.company\.com$',
          'accept' => 1,
          'users' => [ 'root', 'wwwrun' ],
          'sql' => {
               'select' => 'SELECT * FROM foo',
               'insert' => 'INSERT INTO foo VALUES (?, ?, ?)'
               }
        }

then only the users root and wwwrun may connect from admin.company.com,
executing arbitrary queries, but only wwwrun may connect from other
hosts and is restricted to

    $sth->prepare("select");

or

    $sth->prepare("insert");

which in fact are "SELECT * FROM foo" or "INSERT INTO foo VALUES (?, ?, ?)".


=head1 AUTHOR

    Copyright (c) 1997    Jochen Wiedmann
                          Am Eisteich 9
                          72555 Metzingen
                          Germany

                          Email: joe@ispsoft.de
                          Phone: +49 7123 14881

The DBI::ProxyServer module is free software; you can redistribute it
and/or modify it under the same terms as Perl itself. In particular
permission is granted to Tim Bunce for distributing this as a part of
the DBI.


=head1 SEE ALSO

L<dbiproxy(1)>, L<DBD::Proxy(3)>, L<DBI(3)>, L<RPC::PlServer(3)>,
L<RPC::PlClient(3)>, L<Net::Daemon(3)>, L<Net::Daemon::Log(3)>,
L<Sys::Syslog(3)>, L<Win32::EventLog(3)>, L<syslog(2)>
Commit	Line	Data
86530b38 AT	1	# -- perl --
	2	#
	3	# DBI::ProxyServer - a proxy server for DBI drivers
	4	#
	5	# Copyright (c) 1997 Jochen Wiedmann
	6	#
	7	# The DBD::Proxy module is free software; you can redistribute it and/or
	8	# modify it under the same terms as Perl itself. In particular permission
	9	# is granted to Tim Bunce for distributing this as a part of the DBI.
	10	#
	11	#
	12	# Author: Jochen Wiedmann
	13	# Am Eisteich 9
	14	# 72555 Metzingen
	15	# Germany
	16	#
	17	# Email: joe@ispsoft.de
	18	# Phone: +49 7123 14881
	19	#
	20	#
	21
	22	require 5.004;
	23	use strict;
	24
	25	use RPC::PlServer 0.2001;
	26	require DBI;
	27	require Config;
	28
	29
	30	package DBI::ProxyServer;
	31
	32
	33	my $haveFileSpec = eval { require File::Spec };
	34	my $tmpDir = $haveFileSpec ? File::Spec->tmpdir() :
	35	($ENV{'TMP'} \|\| $ENV{'TEMP'} \|\| '/tmp');
	36	my $defaultPidFile = $haveFileSpec ?
	37	File::Spec->catdir($tmpDir, "dbiproxy.pid") : "/tmp/dbiproxy.pid";
	38
	39
	40	############################################################################
	41	#
	42	# Constants
	43	#
	44	############################################################################
	45
	46	use vars qw($VERSION @ISA);
	47
	48	$VERSION = "0.2004";
	49	@ISA = qw(RPC::PlServer DBI);
	50
	51
	52	# Most of the options below are set to default values, we note them here
	53	# just for the sake of documentation.
	54	my %DEFAULT_SERVER_OPTIONS;
	55	{
	56	my $o = \%DEFAULT_SERVER_OPTIONS;
	57	$o->{'chroot'} = undef, # To be used in the initfile,
	58	# after loading the required
	59	# DBI drivers.
	60	$o->{'clients'} =
	61	[ { 'mask' => '.*',
	62	'accept' => 1,
	63	'cipher' => undef
	64	}
65	];
66	$o->{'configfile'} = '/etc/dbiproxy.conf' if -f '/etc/dbiproxy.conf';
67	$o->{'debug'} = 0;
68	$o->{'facility'} = 'daemon';
69	$o->{'group'} = undef;
70	$o->{'localaddr'} = undef; # Bind to any local IP number
71	$o->{'localport'} = undef; # Must set port number on the
72	# command line.
73	$o->{'logfile'} = undef; # Use syslog or EventLog.
74	$o->{'methods'} = {
75	'DBI::ProxyServer' => {
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	},
91	'DBI::ProxyServer::st' => {
92	'execute' => 1,
93	'STORE' => 1,
94	'FETCH' => 1,
95	'func' => 1,
96	'fetch' => 1,
97	'finish' => 1
98	}
99	};
100	if ($Config::Config{'usethreads'} eq 'define') {
101	$o->{'mode'} = 'threads';
102	} elsif ($Config::Config{'d_fork'} eq 'define') {
103	$o->{'mode'} = 'fork';
104	} else {
105	$o->{'mode'} = 'single';
106	}
107	$o->{'pidfile'} = $defaultPidFile;
108	$o->{'user'} = undef;
109	};
110
111
112	############################################################################
113	#
114	# Name: Version
115	#
116	# Purpose: Return version string
117	#
118	# Inputs: $class - This class
119	#
120	# Result: Version string; suitable for printing by "--version"
121	#
122	############################################################################
123
124	sub Version {
125	my $version = $DBI::ProxyServer::VERSION;
126	"DBI::ProxyServer $version, Copyright (C) 1998, Jochen Wiedmann";
127	}
128
129
130	############################################################################
131	#
132	# Name: AcceptApplication
133	#
134	# Purpose: Verify DBI DSN
135	#
136	# Inputs: $self - This instance
137	# $dsn - DBI dsn
138	#
139	# Returns: TRUE for a valid DSN, FALSE otherwise
140	#
141	############################################################################
142
143	sub AcceptApplication {
144	my $self = shift; my $dsn = shift;
145	$dsn =~ /^dbi:\w+:/i;
146	}
147
148
149	############################################################################
150	#
151	# Name: AcceptVersion
152	#
153	# Purpose: Verify requested DBI version
154	#
155	# Inputs: $self - Instance
156	# $version - DBI version being requested
157	#
158	# Returns: TRUE for ok, FALSE otherwise
159	#
160	############################################################################
161
162	sub AcceptVersion {
163	my $self = shift; my $version = shift;
164	$DBI::VERSION >= $version;
165	}
166
167
168	############################################################################
169	#
170	# Name: AcceptUser
171	#
172	# Purpose: Verify user and password by connecting to the client and
173	# creating a database connection
174	#
175	# Inputs: $self - Instance
176	# $user - User name
177	# $password - Password
178	#
179	############################################################################
180
181	sub AcceptUser {
182	my $self = shift; my $user = shift; my $password = shift;
183	return 0 if (!$self->SUPER::AcceptUser($user, $password));
184	my $dsn = $self->{'application'};
185	$self->Debug("Connecting to $dsn as $user");
186	local $ENV{DBI_AUTOPROXY} = ''; # :-)
187	$self->{'dbh'} = eval {
188	DBI::ProxyServer->connect($dsn, $user, $password,
189	{ 'PrintError' => 0, 'Warn' => 0,
190	RaiseError => 1 })
191	};
192	if ($@) {
193	$self->Error("Error while connecting to $dsn as $user: $@");
194	return 0;
195	}
196	[1, $self->StoreHandle($self->{'dbh'}) ];
197	}
198
199
200	sub CallMethod {
201	my $server = shift;
202	my $dbh = $server->{'dbh'};
203	# We could store the private_server attribute permanently in
204	# $dbh. However, we'd have a reference loop in that case and
205	# I would be concerned about garbage collection. :-(
206	$dbh->{'private_server'} = $server;
207	$server->Debug("CallMethod: => " . join(",", @_));
208	my @result = eval { $server->SUPER::CallMethod(@_) };
209	undef $dbh->{'private_server'};
210	if (my $msg = $@) {
211	$server->Error($msg);
212	die $msg;
213	} else {
214	$server->Debug("CallMethod: <= " . join(",", @result));
215	}
216	@result;
217	}
218
219
220	sub main {
221	my $server = DBI::ProxyServer->new(\%DEFAULT_SERVER_OPTIONS, \@_);
222	$server->Bind();
223	}
224
225
226	############################################################################
227	#
228	# The DBI part of the proxyserver is implemented as a DBI subclass.
229	# Thus we can reuse some of the DBI methods and overwrite only
230	# those that need additional handling.
231	#
232	############################################################################
233
234	DBI::ProxyServer->init_rootclass();
235
236	package DBI::ProxyServer::dr;
237
238	@DBI::ProxyServer::dr::ISA = qw(DBI::dr);
239
240
241	package DBI::ProxyServer::db;
242
243	@DBI::ProxyServer::db::ISA = qw(DBI::db);
244
245	sub prepare {
246	my($dbh, $statement, $attr, $params) = @_;
247	my $server = $dbh->{'private_server'};
248	if (my $client = $server->{'client'}) {
249	if ($client->{'sql'}) {
250	if ($statement =~ /^\s*(\S+)/) {
251	my $st = $1;
252	if (!($statement = $client->{'sql'}->{$st})) {
253	die "Unknown SQL query: $st";
254	}
255	} else {
256	die "Cannot parse restricted SQL statement: $statement";
257	}
258	}
259	}
260
261	# The difference between the usual prepare and ours is that we implement
262	# a combined prepare/execute. The DBD::Proxy driver doesn't call us for
263	# prepare. Only if an execute happens, then we are called with method
264	# "prepare". Further execute's are called as "execute".
265	my $sth = $dbh->SUPER::prepare($statement, $attr);
266	my @result = $sth->execute($params);
267	my $handle = $server->StoreHandle($sth);
268	my ($NAME, $TYPE);
269	my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
270	if ($NUM_OF_FIELDS) { # is a SELECT
271	$NAME = $sth->{NAME};
272	$TYPE = $sth->{TYPE};
273	}
274	($handle, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'},
275	$NAME, $TYPE, @result);
276	}
277
278	sub table_info {
279	my $dbh = shift;
280	my $sth = $dbh->SUPER::table_info();
281	my $numFields = $sth->{'NUM_OF_FIELDS'};
282	my $names = $sth->{'NAME'};
283	my $types = $sth->{'TYPE'};
284
285	# We wouldn't need to send all the rows at this point, instead we could
286	# make use of $rsth->fetch() on the client as usual.
287	# The problem is that some drivers (namely DBD::ExampleP, DBD::mysql and
288	# DBD::mSQL) are returning foreign sth's here, thus an instance of
289	# DBI::st and not DBI::ProxyServer::st. We could fix this by permitting
290	# the client to execute method DBI::st, but I don't like this.
291	my @rows;
292	while (my $row = $sth->fetchrow_arrayref()) {
293	push(@rows, [@$row]);
294	}
295	($numFields, $names, $types, @rows);
296	}
297
298
299	package DBI::ProxyServer::st;
300
301	@DBI::ProxyServer::st::ISA = qw(DBI::st);
302
303	sub execute {
304	my $sth = shift; my $params = shift;
305	my @outParams;
306
307	if ($params) {
308	for (my $i = 0; $i < @$params;) {
309	my $param = $params->[$i++];
310	if (!ref($param)) {
311	$sth->bind_param($i, $param);
312	} else {
313	# value, type => bind_param,
314	# value, type, maxlen => bind_param_inout
315	if (@$param <= 2) {
316	$sth->bind_param($i, @$param);
317	} else {
318	$sth->bind_param_inout($i, @$param);
319	my $ref = shift @$param;
320	push(@outParams, $ref);
321	}
322	}
323	}
324	}
325
326	my $rows = $sth->SUPER::execute();
327	($rows, @outParams);
328	}
329
330	sub fetch {
331	my $sth = shift; my $numRows = shift \|\| 1;
332	my($ref, @rows);
333	while ($numRows-- && ($ref = $sth->fetchrow_arrayref())) {
334	push(@rows, [@$ref]);
335	}
336	@rows;
337	}
338
339
340	1;
341
342
343	__END__
344
345	=head1 NAME
346
347	DBI::ProxyServer - a server for the DBD::Proxy driver
348
349
350	=head1 SYNOPSIS
351
352	use DBI::ProxyServer;
353	DBI::ProxyServer::main(@ARGV);
354
355
356	=head1 DESCRIPTION
357
358	DBI::Proxy Server is a module for implementing a proxy for the DBI proxy
359	driver, DBD::Proxy. It allows access to databases over the network if the
360	DBMS does not offer networked operations. But the proxy server might be
361	usefull for you, even if you have a DBMS with integrated network
362	functionality: It can be used as a DBI proxy in a firewalled environment.
363
364	DBI::ProxyServer runs as a daemon on the machine with the DBMS or on the
365	firewall. The client connects to the agent using the DBI driver DBD::Proxy,
366	thus in the exactly same way than using DBD::mysql, DBD::mSQL or any other
367	DBI driver.
368
369	The agent is implemented as a RPC::PlServer application. Thus you have
370	access to all the possibilities of this module, in particular encryption
371	and a similar configuration file. DBI::ProxyServer adds the possibility of
372	query restrictions: You can define a set of queries that a client may
373	execute and restrict access to those. (Requires a DBI driver that supports
374	parameter binding.) See L</CONFIGURATION FILE>.
375
376
377	=head1 OPTIONS
378
379	When calling the DBI::ProxyServer::main() function, you supply an
380	array of options. (@ARGV, the array of command line options is used,
381	if you don't.) These options are parsed by the Getopt::Long module.
382	The ProxyServer inherits all of RPC::PlServer's and hence Net::Daemon's
383	options and option handling, in particular the ability to read
384	options from either the command line or a config file. See
385	L<RPC::PlServer(3)>. See L<Net::Daemon(3)>. Available options include
386
387	=over 4
388
389	=item I<chroot> (B<--chroot=dir>)
390
391	(UNIX only) After doing a bind(), change root directory to the given
392	directory by doing a chroot(). This is usefull for security, but it
393	restricts the environment a lot. For example, you need to load DBI
394	drivers in the config file or you have to create hard links to Unix
395	sockets, if your drivers are using them. For example, with MySQL, a
396	config file might contain the following lines:
397
398	my $rootdir = '/var/dbiproxy';
399	my $unixsockdir = '/tmp';
400	my $unixsockfile = 'mysql.sock';
401	foreach $dir ($rootdir, "$rootdir$unixsockdir") {
402	mkdir 0755, $dir;
403	}
404	link("$unixsockdir/$unixsockfile",
405	"$rootdir$unixsockdir/$unixsockfile");
406	require DBD::mysql;
407
408	{
409	'chroot' => $rootdir,
410	...
411	}
412
413	If you don't know chroot(), think of an FTP server where you can see a
414	certain directory tree only after logging in. See also the --group and
415	--user options.
416
417	=item I<clients>
418
419	An array ref with a list of clients. Clients are hash refs, the attributes
420	I<accept> (0 for denying access and 1 for permitting) and I<mask>, a Perl
421	regular expression for the clients IP number or its host name. See
422	L<"Access control"> below.
423
424	=item I<configfile> (B<--configfile=file>)
425
426	Config files are assumed to return a single hash ref that overrides the
427	arguments of the new method. However, command line arguments in turn take
428	precedence over the config file. See the L<"CONFIGURATION FILE"> section
429	below for details on the config file.
430
431	=item I<debug> (B<--debug>)
432
433	Turn debugging mode on. Mainly this asserts that logging messages of
434	level "debug" are created.
435
436	=item I<facility> (B<--facility=mode>)
437
438	(UNIX only) Facility to use for L<Sys::Syslog (3)>. The default is
439	B<daemon>.
440
441	=item I<group> (B<--group=gid>)
442
443	After doing a bind(), change the real and effective GID to the given.
444	This is usefull, if you want your server to bind to a privileged port
445	(<1024), but don't want the server to execute as root. See also
446	the --user option.
447
448	GID's can be passed as group names or numeric values.
449
450	=item I<localaddr> (B<--localaddr=ip>)
451
452	By default a daemon is listening to any IP number that a machine
453	has. This attribute allows to restrict the server to the given
454	IP number.
455
456	=item I<localport> (B<--localport=port>)
457
458	This attribute sets the port on which the daemon is listening. It
459	must be given somehow, as there's no default.
460
461	=item I<logfile> (B<--logfile=file>)
462
463	Be default logging messages will be written to the syslog (Unix) or
464	to the event log (Windows NT). On other operating systems you need to
465	specify a log file. The special value "STDERR" forces logging to
466	stderr. See L<Net::Daemon::Log(3)> for details.
467
468	=item I<mode> (B<--mode=modename>)
469
470	The server can run in three different modes, depending on the environment.
471
472	If you are running Perl 5.005 and did compile it for threads, then the
473	server will create a new thread for each connection. The thread will
474	execute the server's Run() method and then terminate. This mode is the
475	default, you can force it with "--mode=threads".
476
477	If threads are not available, but you have a working fork(), then the
478	server will behave similar by creating a new process for each connection.
479	This mode will be used automatically in the absence of threads or if
480	you use the "--mode=fork" option.
481
482	Finally there's a single-connection mode: If the server has accepted a
483	connection, he will enter the Run() method. No other connections are
484	accepted until the Run() method returns (if the client disconnects).
485	This operation mode is usefull if you have neither threads nor fork(),
486	for example on the Macintosh. For debugging purposes you can force this
487	mode with "--mode=single".
488
489	=item I<pidfile> (B<--pidfile=file>)
490
491	(UNIX only) If this option is present, a PID file will be created at the
492	given location.
493
494	=item I<user> (B<--user=uid>)
495
496	After doing a bind(), change the real and effective UID to the given.
497	This is usefull, if you want your server to bind to a privileged port
498	(<1024), but don't want the server to execute as root. See also
499	the --group and the --chroot options.
500
501	UID's can be passed as group names or numeric values.
502
503	=item I<version> (B<--version>)
504
505	Supresses startup of the server; instead the version string will
506	be printed and the program exits immediately.
507
508	=back
509
510
511	=head1 CONFIGURATION FILE
512
513	The configuration file is just that of I<RPC::PlServer> or I<Net::Daemon>
514	with some additional attributes in the client list.
515
516	The config file is a Perl script. At the top of the file you may include
517	arbitraty Perl source, for example load drivers at the start (usefull
518	to enhance performance), prepare a chroot environment and so on.
519
520	The important thing is that you finally return a hash ref of option
521	name/value pairs. The possible options are listed above.
522
523	All possibilities of Net::Daemon and RPC::PlServer apply, in particular
524
525	=over 4
526
527	=item Host and/or User dependent access control
528
529	=item Host and/or User dependent encryption
530
531	=item Changing UID and/or GID after binding to the port
532
533	=item Running in a chroot() environment
534
535	=back
536
537	Additionally the server offers you query restrictions. Suggest the
538	following client list:
539
540	'clients' => [
541	{ 'mask' => '^admin\.company\.com$',
542	'accept' => 1,
543	'users' => [ 'root', 'wwwrun' ],
544	},
545	{
546	'mask' => '^admin\.company\.com$',
547	'accept' => 1,
548	'users' => [ 'root', 'wwwrun' ],
549	'sql' => {
550	'select' => 'SELECT * FROM foo',
551	'insert' => 'INSERT INTO foo VALUES (?, ?, ?)'
552	}
553	}
554
555	then only the users root and wwwrun may connect from admin.company.com,
556	executing arbitrary queries, but only wwwrun may connect from other
557	hosts and is restricted to
558
559	$sth->prepare("select");
560
561	or
562
563	$sth->prepare("insert");
564
565	which in fact are "SELECT * FROM foo" or "INSERT INTO foo VALUES (?, ?, ?)".
566
567
568
569
570	=head1 AUTHOR
571
572	Copyright (c) 1997 Jochen Wiedmann
573	Am Eisteich 9
574	72555 Metzingen
575	Germany
576
577	Email: joe@ispsoft.de
578	Phone: +49 7123 14881
579
580	The DBI::ProxyServer module is free software; you can redistribute it
581	and/or modify it under the same terms as Perl itself. In particular
582	permission is granted to Tim Bunce for distributing this as a part of
583	the DBI.
584
585
586	=head1 SEE ALSO
587
588	L<dbiproxy(1)>, L<DBD::Proxy(3)>, L<DBI(3)>, L<RPC::PlServer(3)>,
589	L<RPC::PlClient(3)>, L<Net::Daemon(3)>, L<Net::Daemon::Log(3)>,
590	L<Sys::Syslog(3)>, L<Win32::EventLog(3)>, L<syslog(2)>