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

From Curtis Von Lintel
DateFri, 06 Jul 2007 09:09:37 -0500
Subject Re: [greenstone-users] Fwd: Unresolved IIS6 issue with gliserver.pl
In-Reply-To (C6AF9299-2F52-47A6-A213-32233B830785-dlconsulting-com)
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
> www.dlconsulting.com
>
>
> Begin forwarded message:
>
>> *From: *Stefan Boddie <stefan@dlconsulting.com
>> <mailto:stefan@dlconsulting.com>>
>> *Date: *13 March 2007 6:33:48 PM
>> *To: *Samuel Tyszler <tyszlers@yu.edu <mailto:tyszlers@yu.edu>>
>> *Cc: *Heather Rolen <rolen@yu.edu <mailto:rolen@yu.edu>>, Michael
>> Dewsnip <michael@dlconsulting.co.nz <mailto: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
>>> <mailto: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_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("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();
>
> ------------------------------------------------------------------------
>
> _______________________________________________
> greenstone-users mailing list
> greenstone-users@list.scms.waikato.ac.nz
> https://list.scms.waikato.ac.nz/mailman/listinfo/greenstone-users
>