/usr/share/perl5/RefDB/SRUserver.pm is in librefdb-sru-perl 0.7-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | #!/usr/bin/perl
## SRUserver.pm: defines a class for a standalone SRU server for RefDB
## markus@mhoenicka.de 2007-08-10
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
package RefDB::SRUserver;
use base qw(HTTP::Server::Simple::CGI);
## some RefDB modules
use RefDB::Prefs;
use RefDB::SRU;
use Sys::Syslog;
=head1 NAME
RefDB::SRUserver - Lightweight SRU server for RefDB
=head1 SYNOPSIS
use warnings;
use strict;
use RefDB::SRUserver;
# change into the directory that contains the sru stylesheets
chdir '<refdblib>/sru' or die "Can't cd to stylesheet directory: $!\n";
# create and start the web server
my $server = RefDB::SRUserver->new();
$server->run();
=head1 DESCRIPTION
This is a simple standalone SRU server for RefDB. By default, it
doesn't thread, fork, scale well, run fast, or do anything else you'd need
to serve out datasets to the world. It is intended to set up a no-frills
SRU server without having to configure a web server like Apache. If you need
performance, or want to allow remote access to your RefDB data, by all means
use the RefDB SRU CGI module with a decent web server instead. The CGI module
is available in the same package as this standalone server.
To add some level of security, an application using this module must run from
or change to the subdirectory which contains the stylesheets. All path info
is stripped, and the stylesheets are then served from the current working
directory. This should keep most users from sharing their /etc/passwd with
everyone else.
=head1 FEEDBACK
Send bug reports, questions, and comments to the refdb-users mailing list at:
refdb-users@lists.sourceforge.net
For list information and archives, please visit:
http://lists.sourceforge.net/lists/listinfo/refdb-users
=head1 AUTHOR
Markus Hoenicka, markus@mhoenicka.de
=head1 SEE ALSO
This module is part of the RefDB package, a reference manager and bibliography tool for markup languages. Please visit http://refdb.sourceforge.net for further information.
=head2 print_banner
This routine prints a banner before the server request-handling loop
starts.
=cut
sub print_banner {
my $self = shift;
print( __PACKAGE__
. ": You can connect to your server at "
. "http://localhost:"
. $self->port
. "/\n"
. "To terminate the server, press Ctrl-c\n");
}
=head2 handle_request CGI
This routine is called whenever your server gets a request it can
handle.
It's called with a CGI object that's been pre-initialized.
=cut
sub handle_request {
my ($self, $query) = @_;
if ($query->path_info() =~ "styles") {
# this is a stylesheet request. Strip the leading directory from the
# path and load the file from the current directory.
$stylepath = $query->path_info();
$stylepath =~ s/.*\/([^\/]+)/$1/;
my $sh = eval { local *FH; open(FH, "< $stylepath") or die; *FH{IO}};
while (<$sh>) {
print $_;
}
return;
}
# else: run the SRU stuff
## read config file settings
my $confdir = $self->{"confdir"};
my $prefs = RefDB::Prefs::->new("$confdir/refdbsrurc", undef);
# this hash receives the parameter-value pairs
my %params = $query->Vars;
# logging options
$params{'logfile'} = (defined($prefs->{"logfile"})) ? $prefs->{"logfile"} : "/var/log/refdbsru.log";
$params{'loglevel'} = (defined($prefs->{"loglevel"})) ? $prefs->{"loglevel"} : 6;
$params{'logdest'} = (defined($prefs->{"logdest"})) ? $prefs->{"logdest"} : 2; ## 0 = stderr, 1 = syslog, 2 = file
# networking options
$params{'server_ip'} = (defined($prefs->{"serverip"})) ? $prefs->{"serverip"} : "127.0.0.1";
$params{'port'} = (defined($prefs->{"port"})) ? $prefs->{"port"} : "9734";
$params{'timeout'} = (defined($prefs->{"timeout"})) ? $prefs->{"timeout"} : "180";
# user authentication
$params{'username'} = (defined($prefs->{"username"})) ? $prefs->{"username"} : "anonymous";
$params{'password'} = (defined($prefs->{"passwd"})) ? $prefs->{"passwd"} : "";
$params{'pdfroot'} = (defined($prefs->{"pdfroot"})) ? $prefs->{"pdfroot"} : "/home/foo/literature";
$params{'xsl_url'} = (defined($prefs->{"xsl_url"})) ? $prefs->{"xsl_url"} : "";
$params{'db_engine'} = (defined($prefs->{"dbserver"})) ? $prefs->{"dbserver"} : undef;
# zeerex parameters
$params{'zeerex_host'} = (defined($prefs->{"zeerex_host"})) ? $prefs->{"zeerex_host"} : "www.change.me";
$params{'zeerex_port'} = (defined($prefs->{"zeerex_port"})) ? $prefs->{"zeerex_port"} : "80";
$params{'zeerex_database'} = (defined($prefs->{"zeerex_database"})) ? $prefs->{"zeerex_database"} : "refs";
$params{'zeerex_databaseInfo_title'} = (defined($prefs->{"zeerex_databaseInfo_title"})) ? $prefs->{"zeerex_databaseInfo_title"} : "Reference Database";
$params{'zeerex_databaseInfo_description'} = (defined($prefs->{"zeerex_databaseInfo_description"})) ? $prefs->{"zeerex_databaseInfo_description"} : "Reference Database";
$params{'zeerex_databaseInfo_author'} = (defined($prefs->{"zeerex_databaseInfo_author"})) ? $prefs->{"zeerex_databaseInfo_author"} : "John Doe";
$params{'zeerex_databaseInfo_contact'} = (defined($prefs->{"zeerex_databaseInfo_contact"})) ? $prefs->{"zeerex_databaseInfo_contact"} : "John\@Doe.org";
# create a new RefDB query object and pass a reference to the
# parameter-value hash
my $refdbquery = new RefDB::SRU(\%params);
# try to figure out the database name. A default database should be
# provided in the config file. Remote users can override this setting
# by providing an additional path info in the URL. E.g.
# http://myserver.com/cgi-bin/refdbsru/?<query> will use the
# default database, whereas
# http://myserver.com/cgi-bin/refdbsru/foo?<query> will use the
# database "foo" instead
if (defined($query->path_info()) && length($query->path_info()) > 1) {
$params{'database'} = $query->path_info();
# strip leading slash
$params{'database'} =~ s/^\///;
}
else {
$params{'database'} = (defined($prefs->{"defaultdb"})) ? $prefs->{"defaultdb"} : "references";
}
$refdbquery->run();
my $result = $refdbquery->response();
print "HTTP/1.0 200 OK\r\nContent-Type: text/xml\r\n\r\n";
print "$result\n";
}
1;
__END__
|