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

From Samuel Tyszler
DateSun, 8 Jul 2007 10:46:34 -0400
Subject RE: [greenstone-users] Fwd: Unresolved IIS6 issue with gliserver.pl
In-Reply-To (468E4D21-1020603-washburn-edu)

It seems that not a few people have reported the same problems. I know that IIS6 is not favored, but some IT departments require its use in certain cases. Obviously Stefan doesn’t mind redistributing the “patch.” Shouldn’t it be posted on the web for others to use? Updated instructions on the IIS page as well?

 

Developers,

 

For those of us stuck with IIS please do not forsake us.

 

Regards,

Sam

 

From: greenstone-users-bounces@list.scms.waikato.ac.nz [mailto:greenstone-users-bounces@list.scms.waikato.ac.nz] On Behalf Of Curtis Von Lintel
Sent: Friday, July 06, 2007 10:10 AM
To: Stefan Boddie
Cc: Greenstone user list
Subject: Re: [greenstone-users] Fwd: Unresolved IIS6 issue with gliserver.pl

 

Bingo. Thanks to Stefan and Michael on this great work.

Curtis

Stefan Boddie wrote:

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

 

 

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 Greenstoneetc 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/html ";

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("Nocommand 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("Nousername 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("Nocollection 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("Nocollection specified.");

    }

    my $file = $gsdl_cgi->clean_param("file");

    if ((!defined $file) || ($file =~ m/^s*$/)) {

 $gsdl_cgi->generate_error("Nofile 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("Nocollection 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("Nocollection 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("Nocollection specified.");

    }

    my $file = $gsdl_cgi->clean_param("file");

    if ((!defined $file) || ($file =~ m/^s*$/)) {

 $gsdl_cgi->generate_error("Nofile 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_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 get_script_options

{

    my ($gsdl_cgi, $username) = @_;

 

    my $script = $gsdl_cgi->clean_param("script");

    if ((!defined $script) || ($script =~ m/^s*$/)) {

 $gsdl_cgi->generate_error("Noscript 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("Nocollection specified.");

    }

    my $source_file = $gsdl_cgi->clean_param("source");

    if ((!defined $source_file) || ($source_file =~ m/^s*$/)) {

 $gsdl_cgi->generate_error("Nosource 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("Notarget 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("Nocollection specified.");

    }

    my $directory = $gsdl_cgi->clean_param("directory");

    if ((!defined $directory) || ($directory =~ m/^s*$/)) {

 $gsdl_cgi->generate_error("Nodirectory 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("Noscript specified.");

    }

    $gsdl_cgi->delete("script");

    my $collection = $gsdl_cgi->clean_param("c");

    if ((!defined $collection) || ($collection =~ m/^s*$/)) {

 $gsdl_cgi->generate_error("Nocollection 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("Nocollection specified.");

    }

    my $file = $gsdl_cgi->clean_param("file");

    if ((!defined $file) || ($file =~ m/^s*$/)) {

 $gsdl_cgi->generate_error("Nofile 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();

 

 


 
_______________________________________________
greenstone-users mailing list
greenstone-users@list.scms.waikato.ac.nz
https://list.scms.waikato.ac.nz/mailman/listinfo/greenstone-users
  


<<attachment>>
Type: image/jpeg
Filename: image001.jpg

download