-
Notifications
You must be signed in to change notification settings - Fork 58
/
dbiproxy.PL
209 lines (141 loc) · 5.84 KB
/
dbiproxy.PL
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
#!/usr/bin/perl
# -*- perl -*-
my $file = $ARGV[0] || 'dbiproxy';
my $script = <<'SCRIPT';
~startperl~
use strict;
my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
my $arg_test = shift(@ARGV) if $ARGV[0] eq '--test';
$ENV{DBI_TRACE} = shift(@ARGV) || 2 if $ARGV[0] =~ s/^--dbitrace=?//;
require DBI::ProxyServer;
# XXX these should probably be moved into DBI::ProxyServer
delete $ENV{IFS};
delete $ENV{CDPATH};
delete $ENV{ENV};
delete $ENV{BASH_ENV};
if ($arg_test) {
require RPC::PlServer::Test;
@DBI::ProxyServer::ISA = qw(RPC::PlServer::Test DBI);
}
DBI::ProxyServer::main(@ARGV);
exit(0);
__END__
=head1 NAME
dbiproxy - A proxy server for the DBD::Proxy driver
=head1 SYNOPSIS
dbiproxy <options> --localport=<port>
=head1 DESCRIPTION
This tool is just a front end for the DBI::ProxyServer package. All it
does is picking options from the command line and calling
DBI::ProxyServer::main(). See L<DBI::ProxyServer> for details.
Available options include:
=over 4
=item B<--chroot=dir>
(UNIX only) After doing a bind(), change root directory to the given
directory by doing a chroot(). This is useful 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 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 "CONFIGURATION FILE" section
in the L<DBI::ProxyServer> documentation for details on the config file.
=item B<--debug>
Turn debugging mode on. Mainly this asserts that logging messages of
level "debug" are created.
=item B<--facility=mode>
(UNIX only) Facility to use for L<Sys::Syslog>. The default is
B<daemon>.
=item B<--group=gid>
After doing a bind(), change the real and effective GID to the given.
This is useful, 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 B<--localaddr=ip>
By default a daemon is listening to any IP number that a machine
has. This attribute allows one to restrict the server to the given
IP number.
=item 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 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> for details.
=item 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 useful if you have neither threads nor fork(),
for example on the Macintosh. For debugging purposes you can force this
mode with "--mode=single".
=item B<--pidfile=file>
(UNIX only) If this option is present, a PID file will be created at the
given location. Default is to not create a pidfile.
=item B<--user=uid>
After doing a bind(), change the real and effective UID to the given.
This is useful, 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 B<--version>
Suppresses startup of the server; instead the version string will
be printed and the program exits immediately.
=back
=head1 AUTHOR
Copyright (c) 1997 Jochen Wiedmann
Am Eisteich 9
72555 Metzingen
Germany
Email: [email protected]
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<DBI::ProxyServer>, L<DBD::Proxy>, L<DBI>
=cut
SCRIPT
require Config;
my $config = {};
$config->{'startperl'} = $Config::Config{'startperl'};
$script =~ s/\~(\w+)\~/$config->{$1}/eg;
if (!(open(FILE, ">$file")) ||
!(print FILE $script) ||
!(close(FILE))) {
die "Error while writing $file: $!\n";
}
chmod 0755, $file;
print "Extracted $file from ",__FILE__," with variable substitutions.\n";
# syntax check resulting file, but only for developers
exit 1 if -d ".svn" || -d ".git" and system($^X, '-wc', '-Mblib', $file) != 0;