[greenstone-users] Fwd: Unresolved IIS6 issue with gliserver.pl

From Stefan Boddie
DateFri, 6 Jul 2007 10:48:07 +1200
Subject [greenstone-users] Fwd: Unresolved IIS6 issue with gliserver.pl
In-Reply-To (45F637BC-3050109-dlconsulting-com)
Hi Jewel,

Attached is the message I sent to Sam Tyler at Yeshiva, which is (I
think) about the same issue you're having.

Good luck,
Stefan Boddie

--
DL Consulting
Greenstone specialists
www.dlconsulting.com


Begin forwarded message:

> From: Stefan Boddie <stefan@dlconsulting.com>
> Date: 13 March 2007 6:33:48 PM
> To: Samuel Tyszler <tyszlers@yu.edu>
> Cc: Heather Rolen <rolen@yu.edu>, Michael Dewsnip
> <michael@dlconsulting.co.nz>
> Subject: Re: Unresolved IIS6 issue with gliserver.pl
>
> Hi Sam,
>
> Ok, I've spent a few hours playing with the GLI server under IIS6.
> There are a couple of differences between IIS5 and IIS6 that
> prevented it from working, and I've patched it up as best I can.
> Note that the problems you saw weren't caused by incorrect HTTP
> headers, as the error messages lead you to believe. They were
> instead caused by the fact that IIS6 appears to send anything the
> perl script writes to STDERR directly to the browser. Errors in the > perl code were therefore causing content to be written out before
> the "Content-type" header, which caused IIS to complain about the
> headers being broken.
>
> I've documented the problems I found today, along with instructions > for what you'll need to do to get it working on your server. I
> haven't sent this to the mailing list, feel free to do so if you
> want to.
>
> * Set up Greenstone and the GLI client as described in the wiki
> page at the following URL.
> http://greenstone.sourceforge.net/wiki/index.php/Remote_Greenstone
>
> * Make sure the web server user has write access to the Greenstone
> etc folder, without which you won't be able to set up a user
> account to use with the GLI server. If you followed the wiki
> instructions for setting up IIS you'll have already done that.
>
> * Don't forget to set up a user belonging to the all-collections-
> editor group, as described in the Authentication section of the
> wiki page. The default admin user does not belong to that group!
>
> * The gliserver.pl script does not work with IIS6, for a couple of
> reasons.
> (a) IIS6 sets the current working directory for the script to the
> top level Greenstone folder, not to the folder in which the script
> is located. The attached gliserver.pl script has a rather
> unsatisfactory (but functional) patch for this problem. If you take > a look at it you'll see it contains a new "BEGIN" subroutine near
> the top of the page. This subroutine sets some hard coded paths so
> the script no longer relies on knowing where it is based on what
> the web server sets the working directory to. You'll need to change > the $cgibin and $java_home variables to suit your environment.
> (b) Perl seems to act rather strangely when run from IIS6, and I'm
> not entirely sure why (or perhaps this is a Win2003 thing, and not
> an IIS thing). It doesn't like to run a program using the backtick
> operators if the STDERR of that program is redirected using the
> "2>&1" syntax. If STDERR isn't redirected, IIS seems to go ahead
> and send the STDERR output of the program directly to the browser,
> which is kind of what we need it to do anyway (the only problem was > it was often sending that output before the HTTP headers were
> sent). I worked around this in a few places by writing out the HTTP > headers a little earlier, and letting the various programs send
> their output directly to the browser, rather than trapping in in
> the gliserver.pl script then sending it on. It's an ugly fix but
> will hopefully get you started.
> In any case, the attached gliserver.pl script has been modified
> from the original. I'd recommend you rename the one currently in
> your Greenstonecgi-bin folder, save this new one to that folder,
> then edit the $cgibin and $java_home variables.
>
> * There's also a problem with running library.exe under IIS6, but I > think you've probably already got that working. Greenstone can't
> find the gsdlsite.cfg file (due to IIS6 setting the working
> directory to something other than where the script lives). You can
> work around that by copying the gsdlsite.cfg file from the
> Greenstonecgi-bin folder to the top level Greenstone folder.
>
> It's perhaps also worth mentioning that the person who wrote the
> comments on the Greenstone wiki, about IIS not being recommended
> for this, wasn't kidding. Greenstone, and particularly the
> gliserver, are not well tested or supported on that platform. If
> there is any possibility of switching to Apache instead you might
> save yourself some headaches.
>
> In any case, good luck with it, and let me know how you get on.
>
> Stefan.
>
>
> Samuel Tyszler wrote:
>> Thank you for getting back to me.
>>
>> Although I cannot be positive that I am doing that correctly, I
>> added what you said to. No matter what the order the errors persist.
>>
>> In the Hello World page I switched to text/plain and it works just >> fine.
>>
>> The troubleshooting may be suffering a bit because I am not versed >> in Perl nor a web programmer. I am sure an expert can look at the
>> code while simultaneously testing off an IIS server and probably
>> find a tiny error somewhere. It would be fantastic if a developer
>> were to directly test against our server. I am not the best one to >> be tweaking the code like this.
>>
>> Best,
>>
>> Sam
>>
>>
>>
>> From: Katherine Don [mailto:kjdon@cs.waikato.ac.nz]
>> Sent: Sunday, March 11, 2007 11:47 PM
>> To: Samuel Tyszler
>> Cc: Greenstone Users List; David Milne
>> Subject: Re: Unresolved IIS6 issue with gliserver.pl
>>
>>
>> Hi Samuel
>>
>> The check-installation command outputs as content-type text/plain. >> I wonder if that makes a difference?
>> Could you modify your hello world to be plain text output and see
>> if it still works?
>>
>> Your script doesn't output the status header, so its unclear
>> whether a missing status header is the problem.
>> But you can try outputting it - the place David suggested wasn't
>> actually the right place.
>> The check-installation commands use generate_ok_message and
>> generate_error methods in cgi-bin/gsdlCGI.pm.
>> Look for these two methods and add
>> $l = 1; # flush STDOUT
>> print STDOUT "Status: 200 OK ";
>> before the line
>> print STDOUT "Content-type:text/plain ";
>> in each one.
>>
>> I don't know whether order of Status and Content-type makes a
>> difference. You can try changing it.
>>
>> Does this help at all???
>>
>> Regards,
>> Katherine
>>
>> Samuel Tyszler wrote:
>>
´┐╝Dear Greenstone Team,
>>
>> I am stuck getting Greenstone to work properly on my IIS 6 server. >> I have sent several emails on this to both the list and individual >> team members where appropriate. It seems that I get a response
>> with a possible clue and a request to follow up (which I have
>> done), but then no response back.
>>
>> It is pretty clear to me that something is wrong with the way the
>> gliserver.pl script outputs headers under IIS. If you look through >> the thread I have included below you will see that I have tested
>> other code which runs successfully and the Greenstone Library runs >> as well. I do not have good enough knowledge of the scripting
>> language to fix this. I was hoping to hear back from David, but I
>> have not as yet.
>>
>> As I have stated below, I am happy to allow the development team
>> access to our server to test any fixes and make them public to the >> community. We are not the only ones experiencing this issue. I
>> have been contacted privately by another institution seeking a fix.
>>
>> I hope that someone will be able to work with us to be able to
>> finally and fully resolve this problem. It is keeping us from
>> going live which we need to do soon. We are in a bind.
>>
>> I truly appreciate any assistance the Greenstone team can render.
>>
>> Samuel D. Tyszler
>> Management Information Services
>> Yeshiva University
>>
>>
>>
>> Thanks for your response.
>>
>>
>>
>> Your suggestion didn't work. But it did give me an insight into
>> the issue and inspired me to test this in a different way. I found >> a "Hello World" type script online and I successfully executed it
>> on the server. So the set up of the web server is ok. Here is the
>> script that runs:
>>
>>
>>
>> #!E:Greenstonebinwindowsperlbinperl.exe
>>
>>
>>
>> print "Content-type: text/htmln ";
>>
>> print <<HTML;
>>
>> <html>
>>
>> <head>
>>
>> <title>A Simple Perl CGI</title>
>>
>> </head>
>>
>> <body>
>>
>> <h1>A Simple Perl CGI</h1>
>>
>> <p>Hello World</p>
>>
>> </body>
>>
>> HTML
>>
>> exit;
>>
>>
>>
>> You can execute that at http://129.98.201.53/gsdl/cgi-bin/
>> helloworld.pl
>>
>>
>>
>> Attempting to execute http://129.98.201.53/gsdl/cgi-bin/
>> gliserver.pl?cmd=check-installation fails.
>>
>>
>>
>> You may have full access to my web server to help diagnose this
>> issue and provide a solution to the community. I just got an email >> from another user in my position who is also seeking a fix. Mine
>> is not an isolated incident. Contact me off list and I will be
>> happy to provide you with credentials that will allow access.
>>
>>
>>
>> Sam
>>
>>
>>
>> -----Original Message-----
>>
>> From: David Milne [mailto:dnk2@cs.waikato.ac.nz]
>>
>> Sent: Wednesday, February 28, 2007 8:57 PM
>>
>> To: Samuel Tyszler
>>
>> Cc: greenstone-users@list.scms.waikato.ac.nz
>>
>> Subject: Re: [greenstone-users] Greenstone on IIS 6?
>>
>>
>>
>> Hi Sam,
>>
>>
>>
>> I dont have an IIS installation so I cant try this out myself.
>>
>>
>>
>> Could you please have a look at the gliserver.pl script in the cgi- >> bin directory?
>>
>> There is a line at the end of the get_script_options method where
>> it outputs the content type. Just before this, try inserting the
>> line:
>>
>>
>>
>> print STDOUT "Status: 200 OK " ;
>>
>>
>>
>> then restart the webserver and see how that works. Let me know
>> what happens either way.
>>
>>
>>
>> Thanks,
>>
>> Dave
>>
>>
>>
>>
>>
>>
>
´┐╝#!c:perlbinperl -w
> # Need to specify the full path of Perl above
>
> BEGIN {
> $| = 1;
> my $cgibin = "c:/program files/greenstone/cgi-bin";
> my $java_home = "C:\Program Files\Java\jre1.6.0";
> unshift(@INC, $cgibin);
> $ENV{'PATH'} .= ";" . $java_home . "\bin";
> chdir($cgibin);
> }
>
> use gsdlCGI;
> use strict;
>
>
> my $authentication_enabled = 1;
> my $debugging_enabled = 0;
>
> my $mail_enabled = 0;
> my $mail_to_address = "user@server"; # Set this appropriately
> my $mail_from_address = "user@server"; # Set this appropriately
> my $mail_smtp_server = "smtp.server"; # Set this appropriately
>
>
> sub main
> {
> my $gsdl_cgi = new gsdlCGI();
>
> # Load the Greenstone modules that we need to use
> $gsdl_cgi->setup_gsdl();
> my $gsdlhome = $ENV{'GSDLHOME'};
> $gsdl_cgi->checked_chdir($gsdlhome);
> require "$gsdlhome/perllib/util.pm"; # This is OK on Windows
> require "$gsdlhome/perllib/cpan/Crypt/UnixCrypt.pm"; # This is > OK on Windows
>
> # Encrypt the password
> if (defined $gsdl_cgi->param("pw")) {
> $gsdl_cgi->param('-name' => "pw", '-value' =>
> &Crypt::UnixCrypt::crypt($gsdl_cgi->clean_param("pw"), "Tp"));
> }
>
> $gsdl_cgi->parse_cgi_args();
>
> # We don't want the gsdlCGI module to return errors and
> warnings in XML
> $gsdl_cgi->{'xml'} = 0;
>
> # Retrieve the (required) command CGI argument
> my $cmd = $gsdl_cgi->clean_param("cmd");
> if (!defined $cmd) {
> $gsdl_cgi->generate_error("No command specified.");
> }
> $gsdl_cgi->delete("cmd");
>
> # The check-installation command has no arguments
> if ($cmd eq "check-installation") {
> &check_installation($gsdl_cgi);
> return;
> }
>
> # All other commands require a username, for locking and
> authentication
> my $username = $gsdl_cgi->clean_param("un");
> if ((!defined $username) || ($username =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No username specified.");
> }
> $gsdl_cgi->delete("un");
>
> if ($cmd eq "delete-collection") {
> &delete_collection($gsdl_cgi, $username);
> }
> elsif ($cmd eq "download-collection") {
> &download_collection($gsdl_cgi, $username);
> }
> elsif ($cmd eq "download-collection-archives") {
> &download_collection_archives($gsdl_cgi, $username);
> }
> elsif ($cmd eq "download-collection-configurations") {
> &download_collection_configurations($gsdl_cgi, $username);
> }
> elsif ($cmd eq "download-collection-file") {
> &download_collection_file($gsdl_cgi, $username);
> }
> elsif ($cmd eq "delete-collection-file") {
> &delete_collection_file($gsdl_cgi, $username);
> }
> elsif ($cmd eq "get-script-options") {
> &get_script_options($gsdl_cgi, $username);
> }
> elsif ($cmd eq "move-collection-file") {
> &move_collection_file($gsdl_cgi, $username);
> }
> elsif ($cmd eq "new-collection-directory") {
> &new_collection_directory($gsdl_cgi, $username);
> }
> elsif ($cmd eq "run-script") {
> &run_script($gsdl_cgi, $username);
> }
> elsif ($cmd eq "timeout-test") {
> while (1) { }
> }
> elsif ($cmd eq "upload-collection-file") {
> &upload_collection_file($gsdl_cgi, $username);
> }
> else {
> $gsdl_cgi->generate_error("Unrecognised command: '$cmd'");
> }
> }
>
>
> sub authenticate_user
> {
> my $gsdl_cgi = shift(@_);
> my $username = shift(@_);
> my $collection = shift(@_);
>
> # Even if we're not authenticating remove the un and pw
> arguments, since these can mess up other scripts
> my $user_password = $gsdl_cgi->clean_param("pw");
> $gsdl_cgi->delete("pw");
>
> # Only authenticate if it is enabled
> return "all-collections-editor" if (!$authentication_enabled);
>
> if ((!defined $user_password) || ($user_password =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("Authentication failed: no password > specified.");
> }
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $etc_directory = &util::filename_cat($gsdlhome, "etc");
> my $users_db_file_path = &util::filename_cat($etc_directory,
> "users.db");
>
> # Use db2txt instead of GDBM_File to get the user accounts
> information
> my $users_db_content = "";
> open(USERS_DB, "db2txt "$users_db_file_path" |");
> while (<USERS_DB>) {
> $users_db_content .= $_;
> }
>
> # Get the user account information from the users.db database
> my %users_db_data = ();
> foreach my $users_db_entry (split(/-{70}/, $users_db_content)) {
> if ($users_db_entry =~ / ?[(.+)] /) {
> $users_db_data{$1} = $users_db_entry;
> }
> }
>
> # Check username
> my $user_data = $users_db_data{$username};
> if (!defined $user_data) {
> $gsdl_cgi->generate_error("Authentication failed: no account for
> user '$username'.");
> }
>
> # Check password
> my ($valid_user_password) = ($user_data =~ /<password>(.*)/);
> if ($user_password ne $valid_user_password) {
> $gsdl_cgi->generate_error("Authentication failed: incorrect
> password.");
> }
>
> # Check group
> my ($user_groups) = ($user_data =~ /<groups>(.*)/);
> if ($collection eq "") {
> # If we're not editing a collection then the user doesn't need to
> be in a particular group
> return $user_groups; # Authentication successful
> }
> foreach my $user_group (split(/,/, $user_groups)) {
> # Does this user have access to all collections?
> if ($user_group eq "all-collections-editor") {
> return $user_groups; # Authentication successful
> }
> # Does this user have access to personal collections, and is this
> one?
> if ($user_group eq "personal-collections-editor" && $collection > =~ /^$username-/) {
> return $user_groups; # Authentication successful
> }
> # Does this user have access to this collection
> if ($user_group eq "$collection-collection-editor") {
> return $user_groups; # Authentication successful
> }
> }
>
> $gsdl_cgi->generate_error("Authentication failed: user is not
> in the required group.");
> }
>
>
> sub lock_collection
> {
> my $gsdl_cgi = shift(@_);
> my $username = shift(@_);
> my $collection = shift(@_);
>
> my $steal_lock = $gsdl_cgi->clean_param("steal_lock");
> $gsdl_cgi->delete("steal_lock");
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collection_directory = &util::filename_cat($gsdlhome,
> "collect", $collection);
> $gsdl_cgi->checked_chdir($collection_directory);
>
> # Check if a lock file already exists for this collection
> my $lock_file_name = "gli.lck";
> if (-e $lock_file_name) {
> # A lock file already exists... check if it's ours
> my $lock_file_content = "";
> open(LOCK_FILE, "<$lock_file_name");
> while (<LOCK_FILE>) {
> $lock_file_content .= $_;
> }
> close(LOCK_FILE);
>
> # Pick out the owner of the lock file
> $lock_file_content =~ /<User>(.*?)</User>/;
> my $lock_file_owner = $1;
>
> # The lock file is ours, so there is no problem
> if ($lock_file_owner eq $username) {
> return;
> }
>
> # The lock file is not ours, so throw an error unless "steal_lock"
> is set
> unless (defined $steal_lock) {
> $gsdl_cgi->generate_error("Collection is locked by:
> $lock_file_owner");
> }
> }
>
> my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday,
> $isdst) = localtime(time);
> my $current_time = sprintf("%02d/%02d/%d %02d:%02d:%02d",
> $mday, $mon + 1, $year + 1900, $hour, $min, $sec);
>
> # Create a lock file for us (in the same format as the GLI) and > we're done
> open(LOCK_FILE, ">$lock_file_name");
> print LOCK_FILE "<?xml version="1.0" encoding="UTF-8"?> ";
> print LOCK_FILE "<LockFile> ";
> print LOCK_FILE " <User>" . $username . "</User> ";
> print LOCK_FILE " <Machine>(Remote)</Machine> ";
> print LOCK_FILE " <Date>" . $current_time . "</Date> ";
> print LOCK_FILE "</LockFile> ";
> close(LOCK_FILE);
> }
>
>
> #
> ---------------------------------------------------------------------- > ------------------------------
> # ACTIONS
> #
> ---------------------------------------------------------------------- > ------------------------------
>
>
> sub check_installation
> {
> my ($gsdl_cgi) = @_;
>
> my $installation_ok = 1;
> my $installation_status = "";
>
> print STDOUT "Content-type: text/plain ";
>
> # Check that Java is installed and accessible
> my $java = $gsdl_cgi->get_java_path();
>
> my $java_command = "$java -version";
> my $java_output = `$java_command`;
> my $java_status = $?;
> if ($java_status < 0) {
> # The Java command failed
> $installation_status = "Java failed -- do you have the Java run-
> time installed? " . $gsdl_cgi->check_java_home() . " ";
> $installation_ok = 0;
> }
> else {
> $installation_status = "Java found: $java_output";
> }
>
>
> # Show the values of some important environment variables
> $installation_status .= " ";
> $installation_status .= "GSDLHOME: " . $ENV{'GSDLHOME'} . " ";
> $installation_status .= "GSDLOS: " . $ENV{'GSDLOS'} . " ";
> $installation_status .= "PATH: " . $ENV{'PATH'} . " ";
>
>
> if ($installation_ok) {
> $gsdl_cgi->generate_ok_message($installation_status .
> " Installation OK!");
> }
> else {
> $gsdl_cgi->generate_error($installation_status);
> }
> }
>
>
> sub delete_collection
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collect_directory = &util::filename_cat($gsdlhome, "collect");
> $gsdl_cgi->checked_chdir($collect_directory);
>
> # Check that the collection exists
> if (!-d $collection) {
> $gsdl_cgi->generate_error("Collection $collection does not exist.");
> }
>
> # Make sure the collection isn't locked by someone else
> &lock_collection($gsdl_cgi, $username, $collection);
>
> $gsdl_cgi->checked_chdir($collect_directory);
> $gsdl_cgi->local_rm_r("$collection");
>
> # Check that the collection was deleted
> if (-e $collection) {
> $gsdl_cgi->generate_error("Could not delete collection
> $collection.");
> }
>
> $gsdl_cgi->generate_ok_message("Collection $collection deleted
> successfully.");
> }
>
>
> sub delete_collection_file
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
> my $file = $gsdl_cgi->clean_param("file");
> if ((!defined $file) || ($file =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No file specified.");
> }
> $file =~ s/|/&util::get_dirsep()/eg; # Convert the '|'
> characters into whatever is right for this OS
>
> # Make sure we don't try to delete anything outside the collection
> if ($file =~ /../) {
> $gsdl_cgi->generate_error("Illegal file specified.");
> }
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collection_directory = &util::filename_cat($gsdlhome,
> "collect", $collection);
> $gsdl_cgi->checked_chdir($collection_directory);
>
> # Make sure the collection isn't locked by someone else
> &lock_collection($gsdl_cgi, $username, $collection);
>
> # Check that the collection file exists
> if (!-e $file) {
> $gsdl_cgi->generate_ok_message("Collection file $file does not > exist.");
> }
> $gsdl_cgi->local_rm_r("$file");
>
> # Check that the collection file was deleted
> if (-e $file) {
> $gsdl_cgi->generate_error("Could not delete collection file $file.");
> }
>
> $gsdl_cgi->generate_ok_message("Collection file $file deleted
> successfully.");
> }
>
>
> sub download_collection
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collect_directory = &util::filename_cat($gsdlhome, "collect");
> $gsdl_cgi->checked_chdir($collect_directory);
>
> # Check that the collection exists
> if (!-d $collection) {
> $gsdl_cgi->generate_error("Collection $collection does not exist.");
> }
>
> # Make sure the collection isn't locked by someone else
> &lock_collection($gsdl_cgi, $username, $collection);
>
> # Zip up the collection
> my $java = $gsdl_cgi->get_java_path();
> my $java_classpath = &util::filename_cat($gsdlhome, "bin",
> "java", "GLIServer.jar");
> my $zip_file_path = &util::filename_cat($collect_directory,
> $username . "-" . $collection . ".zip");
> my $java_args = ""$zip_file_path" "$collect_directory"
> "$collection"";
> my $java_command = "$java -classpath "$java_classpath"
> org.greenstone.gatherer.remote.ZipCollectionShell $java_args";
>
> my $java_output = `$java_command`;
> my $java_status = $?;
> if ($java_status > 0) {
> $gsdl_cgi->generate_error("Java failed: $java_command --
> $java_output Exit status: " . ($java_status / 256) . " " .
> $gsdl_cgi->check_java_home());
> }
>
> # Check that the zip file was created successfully
> if (!-e $zip_file_path || -z $zip_file_path) {
> $gsdl_cgi->generate_error("Collection zip file $zip_file_path > could not be created.");
> }
>
> &put_file($gsdl_cgi, $zip_file_path, "application/zip");
> unlink("$zip_file_path") unless $debugging_enabled;
> }
>
>
> sub download_collection_archives
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collect_directory = &util::filename_cat($gsdlhome, "collect");
> $gsdl_cgi->checked_chdir($collect_directory);
>
> # Check that the collection archives exist
> if (!-d &util::filename_cat($collection, "archives")) {
> $gsdl_cgi->generate_error("Collection archives do not exist.");
> }
>
> # Make sure the collection isn't locked by someone else
> &lock_collection($gsdl_cgi, $username, $collection);
>
> # Zip up the collection archives
> my $java = $gsdl_cgi->get_java_path();
> my $java_classpath = &util::filename_cat($gsdlhome, "bin",
> "java", "GLIServer.jar");
> my $zip_file_path = &util::filename_cat($collect_directory,
> $username . "-" . $collection . "-archives.zip");
> my $java_args = ""$zip_file_path" "$collect_directory"
> "$collection"";
> my $java_command = "$java -classpath "$java_classpath"
> org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";
>
> my $java_output = `$java_command`;
> my $java_status = $?;
> if ($java_status > 0) {
> $gsdl_cgi->generate_error("Java failed: $java_command --
> $java_output Exit status: " . ($java_status / 256) . " " .
> $gsdl_cgi->check_java_home());
> }
>
> # Check that the zip file was created successfully
> if (!-e $zip_file_path || -z $zip_file_path) {
> $gsdl_cgi->generate_error("Collection archives zip file
> $zip_file_path could not be created.");
> }
>
> &put_file($gsdl_cgi, $zip_file_path, "application/zip");
> unlink("$zip_file_path") unless $debugging_enabled;
> }
>
>
> # Collection locking unnecessary because this action isn't related
> to a particular collection
> sub download_collection_configurations
> {
> my ($gsdl_cgi, $username) = @_;
>
> print STDOUT "Content-type: text/plain ";
>
> # Users can be in any group to perform this action
> my $user_groups = &authenticate_user($gsdl_cgi, $username, "");
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collect_directory = &util::filename_cat($gsdlhome, "collect");
> $gsdl_cgi->checked_chdir($collect_directory);
>
> # Zip up the collection configurations
> my $java = $gsdl_cgi->get_java_path();
> my $java_classpath = &util::filename_cat($gsdlhome, "bin",
> "java", "GLIServer.jar");
> my $zip_file_path = &util::filename_cat($collect_directory,
> $username . "-" . "collection-configurations.zip");
> my $java_args = ""$zip_file_path" "$collect_directory"
> "$username" "$user_groups"";
> my $java_command = "$java -classpath "$java_classpath"
> org.greenstone.gatherer.remote.ZipCollectionConfigurations
> $java_args";
>
> my $java_output = `$java_command`;
> my $java_status = $?;
> if ($java_status > 0) {
> $gsdl_cgi->generate_error("Java failed: $java_command --
> $java_output Exit status: " . ($java_status / 256) . " " .
> $gsdl_cgi->check_java_home());
> }
>
> # Check that the zip file was created successfully
> if (!-e $zip_file_path || -z $zip_file_path) {
> $gsdl_cgi->generate_error("Collection configurations zip file > $zip_file_path could not be created.");
> }
>
> &put_file($gsdl_cgi, $zip_file_path, "application/zip");
> unlink("$zip_file_path") unless $debugging_enabled;
> }
>
>
> sub download_collection_file
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
> my $file = $gsdl_cgi->clean_param("file");
> if ((!defined $file) || ($file =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No file specified.");
> }
> $file =~ s/|/&util::get_dirsep()/eg; # Convert the '|'
> characters into whatever is right for this OS
>
> # Make sure we don't try to download anything outside the
> collection
> if ($file =~ /../) {
> $gsdl_cgi->generate_error("Illegal file specified.");
> }
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collection_directory = &util::filename_cat($gsdlhome,
> "collect", $collection);
> $gsdl_cgi->checked_chdir($collection_directory);
>
> # Check that the collection file exists
> if (!-e $file) {
> $gsdl_cgi->generate_error("Collection file $file does not exist.");
> }
>
> # Make sure the collection isn't locked by someone else
> &lock_collection($gsdl_cgi, $username, $collection);
>
> # Zip up the collection file
> my $java = $gsdl_cgi->get_java_path();
> my $java_classpath = &util::filename_cat($gsdlhome, "bin",
> "java", "GLIServer.jar");
> my $zip_file_path = &util::filename_cat($collection_directory, > $username . "-" . $collection . "-file.zip");
> my $java_args = ""$zip_file_path" "$collection_directory" > "$file"";
> my $java_command = "$java -classpath "$java_classpath"
> org.greenstone.gatherer.remote.ZipFiles $java_args";
>
> my $java_output = `$java_command`;
> my $java_status = $?;
> if ($java_status > 0) {
> $gsdl_cgi->generate_error("Java failed: $java_command --
> $java_outputnExit status: " . ($java_status / 256) . " " .
> $gsdl_cgi->check_java_home());
> }
>
> # Check that the zip file was created successfully
> if (!-e $zip_file_path || -z $zip_file_path) {
> $gsdl_cgi->generate_error("Collection archives zip file
> $zip_file_path could not be created.");
> }
>
> &put_file($gsdl_cgi, $zip_file_path, "application/zip");
> unlink("$zip_file_path") unless $debugging_enabled;
> }
>
>
> # Collection locking unnecessary because this action isn't related
> to a particular collection
> sub get_script_options
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $script = $gsdl_cgi->clean_param("script");
> if ((!defined $script) || ($script =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No script specified.");
> }
> $gsdl_cgi->delete("script");
>
> # Users can be in any group to perform this action
> &authenticate_user($gsdl_cgi, $username, "");
>
> my $perl_args = "";
> if ($script eq "classinfo.pl") {
> $perl_args = $gsdl_cgi->clean_param("classifier") || "";
> $gsdl_cgi->delete("classifier");
> }
> if ($script eq "pluginfo.pl") {
> $perl_args = $gsdl_cgi->clean_param("plugin") || "";
> $gsdl_cgi->delete("plugin");
> }
>
> foreach my $cgi_arg_name ($gsdl_cgi->param) {
> my $cgi_arg_value = $gsdl_cgi->clean_param($cgi_arg_name) || "";
> $cgi_arg_value = $gsdl_cgi->safe_val($cgi_arg_value);
> if ($cgi_arg_value eq "") {
> $perl_args = "-$cgi_arg_name " . $perl_args;
> }
> else {
> $perl_args = "-$cgi_arg_name "$cgi_arg_value" " . $perl_args;
> }
> }
>
> print STDOUT "Content-type:text/plain ";
> my $perl_command = "perl -S $script $perl_args";
> my $perl_output = `$perl_command`;
> my $perl_status = $?;
> if ($perl_status > 0) {
> $gsdl_cgi->generate_error("Perl failed: $perl_command --
> $perl_output Exit status: " . ($perl_status / 256));
> }
>
> print STDOUT $perl_output if defined $perl_output;
> }
>
>
> sub move_collection_file
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
> my $source_file = $gsdl_cgi->clean_param("source");
> if ((!defined $source_file) || ($source_file =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No source file specified.");
> }
> $source_file =~ s/|/&util::get_dirsep()/eg; # Convert the '|' > characters into whatever is right for this OS
> my $target_file = $gsdl_cgi->clean_param("target");
> if ((!defined $target_file) || ($target_file =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No target file specified.");
> }
> $target_file =~ s/|/&util::get_dirsep()/eg; # Convert the '|' > characters into whatever is right for this OS
>
> # Make sure we don't try to move anything outside the collection
> if ($source_file =~ /../ || $target_file =~ /../) {
> $gsdl_cgi->generate_error("Illegal file specified.");
> }
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collection_directory = &util::filename_cat($gsdlhome,
> "collect", $collection);
> $gsdl_cgi->checked_chdir($collection_directory);
>
> # Check that the collection source file exists
> if (!-e $source_file) {
> $gsdl_cgi->generate_error("Collection file $source_file does not
> exist.");
> }
>
> # Make sure the collection isn't locked by someone else
> &lock_collection($gsdl_cgi, $username, $collection);
>
> &util::mv($source_file, $target_file);
>
> # Check that the collection source file was moved
> if (-e $source_file || !-e $target_file) {
> $gsdl_cgi->generate_error("Could not move collection file
> $source_file to $target_file.");
> }
>
> $gsdl_cgi->generate_ok_message("Collection file $source_file
> moved to $target_file successfully.");
> }
>
>
> sub new_collection_directory
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
> my $directory = $gsdl_cgi->clean_param("directory");
> if ((!defined $directory) || ($directory =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No directory specified.");
> }
> $directory =~ s/|/&util::get_dirsep()/eg; # Convert the '|' > characters into whatever is right for this OS
>
> # Make sure we don't try to create anything outside the collection
> if ($directory =~ /../) {
> $gsdl_cgi->generate_error("Illegal directory specified.");
> }
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collection_directory = &util::filename_cat($gsdlhome,
> "collect", $collection);
> $gsdl_cgi->checked_chdir($collection_directory);
>
> # Check that the collection directory doesn't already exist
> # ZipTools doesn't zip up empty directories, so this causes an
> error when downloading a new collection as we explicity
> # try to create the import directory
> # if (-d $directory) {
> #$gsdl_cgi->generate_error("Collection directory $directory
> already exists.");
> # }
>
> # Make sure the collection isn't locked by someone else
> &lock_collection($gsdl_cgi, $username, $collection);
>
> &util::mk_dir($directory);
>
> # Check that the collection directory was created
> if (!-d $directory) {
> $gsdl_cgi->generate_error("Could not create collection directory
> $directory.");
> }
>
> $gsdl_cgi->generate_ok_message("Collection directory $directory > created successfully.");
> }
>
>
> sub run_script
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $script = $gsdl_cgi->clean_param("script");
> if ((!defined $script) || ($script =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No script specified.");
> }
> $gsdl_cgi->delete("script");
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
> $gsdl_cgi->delete("c");
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> # Make sure the collection isn't locked by someone else (unless > we're running mkcol.pl, of course)
> &lock_collection($gsdl_cgi, $username, $collection) unless
> ($script eq "mkcol.pl");
>
> # Last argument is the collection name, except for
> explode_metadata_database.pl
> my $perl_args = $collection;
> if ($script eq "explode_metadata_database.pl") {
> # Last argument is the file to be exploded
> my $file = $gsdl_cgi->clean_param("file");
> if ((!defined $file) || ($file =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No file specified.");
> }
> $gsdl_cgi->delete("file");
> $perl_args = $file;
> }
>
> foreach my $cgi_arg_name ($gsdl_cgi->param) {
> my $cgi_arg_value = $gsdl_cgi->safe_val($gsdl_cgi->clean_param > ($cgi_arg_name));
> if ($cgi_arg_value eq "") {
> $perl_args = "-$cgi_arg_name " . $perl_args;
> }
> else {
> $perl_args = "-$cgi_arg_name "$cgi_arg_value" " . $perl_args;
> }
> }
>
> print STDOUT "Content-type:text/plain ";
>
> my $perl_command = "perl -S $script $perl_args";
> if (!open(PIN, "$perl_command |")) {
> $gsdl_cgi->generate_error("Unable to execute command:
> $perl_command");
> }
>
> while (defined (my $perl_output_line = <PIN>)) {
> print STDOUT $perl_output_line;
> }
> close(PIN);
>
> my $perl_status = $?;
> if ($perl_status > 0) {
> $gsdl_cgi->generate_error("Perl failed: $perl_command -- Exit > status: " . ($perl_status / 256));
> }
> elsif ($mail_enabled) {
> if ($script eq "buildcol.pl") {
> &send_mail($gsdl_cgi, "Remote Greenstone building event", > "Build of collection '$collection' complete.");
> }
> }
> }
>
>
> sub upload_collection_file
> {
> my ($gsdl_cgi, $username) = @_;
>
> my $collection = $gsdl_cgi->clean_param("c");
> if ((!defined $collection) || ($collection =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No collection specified.");
> }
> my $file = $gsdl_cgi->clean_param("file");
> if ((!defined $file) || ($file =~ m/^s*$/)) {
> $gsdl_cgi->generate_error("No file specified.");
> }
> my $directory = $gsdl_cgi->clean_param("directory") || "";
> $directory =~ s/|/&util::get_dirsep()/eg; # Convert the '|' > characters into whatever is right for this OS
> my $zip = $gsdl_cgi->clean_param("zip");
>
> # Make sure we don't try to upload anything outside the collection
> if ($file =~ /../) {
> $gsdl_cgi->generate_error("Illegal file specified.");
> }
> if ($directory =~ /../) {
> $gsdl_cgi->generate_error("Illegal directory specified.");
> }
>
> # Ensure the user is allowed to edit this collection
> &authenticate_user($gsdl_cgi, $username, $collection);
>
> my $gsdlhome = $ENV{'GSDLHOME'};
> my $collection_directory = &util::filename_cat($gsdlhome,
> "collect", $collection);
> $gsdl_cgi->checked_chdir($collection_directory);
>
> # Make sure the collection isn't locked by someone else
> &lock_collection($gsdl_cgi, $username, $collection);
>
> my $directory_path = &util::filename_cat($collection_directory, > $directory);
> if (!-d $directory_path) {
> &util::mk_dir($directory_path);
> if (!-d $directory_path) {
> $gsdl_cgi->generate_error("Could not create directory
> $directory_path.");
> }
> }
>
> my $file_path = &util::filename_cat($directory_path,
> $username . "-" . $file);
> if (!open(FOUT, ">$file_path")) {
> $gsdl_cgi->generate_error("Unable to write file $file_path");
> }
>
> # Read the uploaded data and write it out to file
> my $buf;
> my $num_bytes = 0;
> binmode(FOUT);
> while (read(STDIN, $buf, 1024) > 0) {
> print FOUT $buf;
> $num_bytes += length($buf);
> }
> close(FOUT);
>
> # If we have downloaded a zip file, unzip it
> if (defined $zip) {
> my $java = $gsdl_cgi->get_java_path();
> my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java",
> "GLIServer.jar");
> my $java_args = ""$file_path" "$directory_path"";
> my $java_command = "$java -classpath "$java_classpath"
> org.greenstone.gatherer.remote.Unzip $java_args";
>
> my $java_output = `$java_command`;
> my $java_status = $?;
>
> # Remove the zip file once we have unzipped it, since it is an > intermediate file only
> unlink("$file_path");
>
> if ($java_status > 0) {
> $gsdl_cgi->generate_error("Java failed: $java_command -- > $java_output Exit status: " . ($java_status / 256) . " " .
> $gsdl_cgi->check_java_home());
> }
> }
>
> $gsdl_cgi->generate_ok_message("Collection file $file uploaded
> successfully.");
> }
>
>
> sub put_file
> {
> my $gsdl_cgi = shift(@_);
> my $file_path = shift(@_);
> my $content_type = shift(@_);
>
> if (open(PIN, "<$file_path")) {
> print STDOUT "Content-type:$content_type ";
>
> my $buf;
> my $num_bytes = 0;
> binmode(PIN);
> while (read(PIN, $buf, 1024) > 0) {
> print STDOUT $buf;
> $num_bytes += length($buf);
> }
>
> close(PIN);
> }
> else {
> $gsdl_cgi->generate_error("Unable to read file $file_path $!");
> }
> }
>
>
> sub send_mail
> {
> my $gsdl_cgi = shift(@_);
> my $mail_subject = shift(@_);
> my $mail_content = shift(@_);
>
> my $sendmail_command = "perl -S sendmail.pl";
> $sendmail_command .= " -to "" . $mail_to_address . """;
> $sendmail_command .= " -from "" . $mail_from_address . """;
> $sendmail_command .= " -smtp "" . $mail_smtp_server . """;
> $sendmail_command .= " -subject "" . $mail_subject . """;
>
> if (!open(POUT, "| $sendmail_command")) {
> $gsdl_cgi->generate_error("Unable to execute command:
> $sendmail_command");
> }
> print POUT $mail_content . " ";
> close(POUT);
> }
>
>
> &main();