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

From Michael Dewsnip
DateMon, 09 Jul 2007 10:40:07 +1200
Subject Re: [greenstone-users] Fwd: Unresolved IIS6 issue with gliserver.pl
In-Reply-To (65B0C0E071C62648A240F99B77B42FC1C34DE6-RHINO-yuad-uds-yu-edu)
Hi Sam,

Yes, I will be committing Stefan's changes back into the Greenstone
repository and updating the wiki documentation.

Regards,

Michael

--
DL Consulting
Greenstone Digital Library and Digitisation Specialists
contact@dlconsulting.com
www.dlconsulting.com

Samuel Tyszler wrote:
>
> 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
>
> www.dlconsulting.com <http://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_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();
>
>
>
>
> ------------------------------------------------------------------------
>
>
>
>
> _______________________________________________
> greenstone-users mailing list
> greenstone-users@list.scms.waikato.ac.nz <mailto:greenstone-users@list.scms.waikato.ac.nz>
> https://list.scms.waikato.ac.nz/mailman/listinfo/greenstone-users
>
> ------------------------------------------------------------------------
>
> _______________________________________________
> greenstone-users mailing list
> greenstone-users@list.scms.waikato.ac.nz
> https://list.scms.waikato.ac.nz/mailman/listinfo/greenstone-users
>