source: greenstone3/trunk/web/WEB-INF/cgi/gliserver.pl@ 16326

Last change on this file since 16326 was 16326, checked in by ak19, 16 years ago

Calls to execute java nested inside quotes in case the path to java contains spaces. This now works on Windows.
  • Property svn:executable set to *
File size: 42.1 KB
Line 
1#!/usr/bin/perl -w
2# Need to specify the full path of Perl above
3
4# This file merges Michael Dewsnip's gliserver.pl for GS2 and Quan Qiu's gliserver4gs3.pl (GS3)
5
6use strict;
7no strict 'subs';
8no strict 'refs'; # allow filehandles to be variables and viceversa
9
10
11# Set this to 1 to work around IIS 6 craziness
12my $iis6_mode = 0;
13
14##
15# IIS 6: for some reason, IIS runs this script with the working directory set to the Greenstone
16# directory rather than the cgi-bin directory, causing lots of stuff to fail
17if ($iis6_mode)
18{
19 # Change into cgi-bin directory - need to ensure it exists, since gliserver deals with both GS2 and GS3
20 if(-e "cgi-bin" && -d "cgi-bin") { # GS2
21 chdir("cgi-bin");
22 } else { # iis6_mode is not applicable for Greenstone 3
23 $iis6_mode = 0;
24 }
25}
26
27
28# We use require and an eval here (instead of "use package") to catch any errors loading the module (for IIS)
29eval("require \"gsdlCGI.pm\"");
30if ($@)
31{
32 print STDOUT "Content-type:text/plain\n\n";
33 print STDOUT "ERROR: $@\n";
34 exit 0;
35}
36
37
38#my $authentication_enabled = 0;
39my $debugging_enabled = 0; # if 1, debugging is enabled and unlinking intermediate files (deleting files) will not happen
40
41my $mail_enabled = 0;
42my $mail_to_address = "user\@server"; # Set this appropriately
43my $mail_from_address = "user\@server"; # Set this appropriately
44my $mail_smtp_server = "smtp.server"; # Set this appropriately
45
46sub main
47{
48 my $gsdl_cgi = new gsdlCGI();
49
50 # Load the Greenstone modules that we need to use
51 $gsdl_cgi->setup_gsdl();
52 my $gsdlhome = $ENV{'GSDLHOME'};
53
54 $gsdl_cgi->checked_chdir($gsdlhome);
55
56 # Encrypt the password
57 $gsdl_cgi->encrypt_password();
58
59 $gsdl_cgi->parse_cgi_args();
60
61 # We don't want the gsdlCGI module to return errors and warnings in XML
62 $gsdl_cgi->{'xml'} = 0;
63
64 # Retrieve the (required) command CGI argument
65 my $cmd = $gsdl_cgi->clean_param("cmd");
66 if (!defined $cmd) {
67 $gsdl_cgi->generate_error("No command specified.");
68 }
69 $gsdl_cgi->delete("cmd");
70
71 # The check-installation, greenstone-server-version and get-library-url commands have no arguments
72 if ($cmd eq "check-installation") {
73 &check_installation($gsdl_cgi);
74 return;
75 }
76 elsif ($cmd eq "greenstone-server-version") {
77 &greenstone_server_version($gsdl_cgi);
78 return;
79 }
80 elsif ($cmd eq "get-library-url-suffix") {
81 &get_library_url_suffix($gsdl_cgi);
82 return;
83 }
84
85 # All other commands require a username, for locking and authentication
86 my $username = $gsdl_cgi->clean_param("un");
87 if ((!defined $username) || ($username =~ m/^\s*$/)) {
88 $gsdl_cgi->generate_error("No username specified.");
89 }
90 $gsdl_cgi->delete("un");
91
92 # Get then remove the ts (timestamp) argument (since this can mess up other scripts)
93 my $timestamp = $gsdl_cgi->clean_param("ts");
94 if ((!defined $timestamp) || ($timestamp =~ m/^\s*$/)) {
95 $timestamp = time(); # Fall back to using the Perl time() function to generate a timestamp
96 }
97 $gsdl_cgi->delete("ts");
98
99 my $site; # undefined on declaration, see http://perldoc.perl.org/perlsyn.html
100 if($gsdl_cgi->greenstone_version() != 2) { # all GS versions after 2 may define site
101 $site = $gsdl_cgi->clean_param("site");
102 if (!defined $site) {
103 $gsdl_cgi->generate_error("No site specified.");
104 }
105 $gsdl_cgi->delete("site");
106 }
107
108
109 if ($cmd eq "delete-collection") {
110 &delete_collection($gsdl_cgi, $username, $timestamp, $site);
111 }
112 elsif ($cmd eq "download-collection") {
113 &download_collection($gsdl_cgi, $username, $timestamp, $site);
114 }
115 elsif ($cmd eq "download-collection-archives") {
116 &download_collection_archives($gsdl_cgi, $username, $timestamp, $site);
117 }
118 elsif ($cmd eq "download-collection-configurations") {
119 &download_collection_configurations($gsdl_cgi, $username, $timestamp, $site);
120 }
121 elsif ($cmd eq "download-collection-file") {
122 &download_collection_file($gsdl_cgi, $username, $timestamp, $site);
123 }
124 elsif ($cmd eq "delete-collection-file") {
125 &delete_collection_file($gsdl_cgi, $username, $timestamp, $site);
126 }
127 elsif ($cmd eq "get-script-options") {
128 &get_script_options($gsdl_cgi, $username, $timestamp, $site);
129 }
130 elsif ($cmd eq "move-collection-file") {
131 &move_collection_file($gsdl_cgi, $username, $timestamp, $site);
132 }
133 elsif ($cmd eq "new-collection-directory") {
134 &new_collection_directory($gsdl_cgi, $username, $timestamp, $site);
135 }
136 elsif ($cmd eq "run-script") {
137 &run_script($gsdl_cgi, $username, $timestamp, $site);
138 }
139 elsif ($cmd eq "timeout-test") {
140 while (1) { }
141 }
142 elsif ($cmd eq "upload-collection-file") {
143 #print STDERR "CMD upload_collection_file\nusername: $username, site: $site, ts: $timestamp\n";
144 &upload_collection_file($gsdl_cgi, $username, $timestamp, $site);
145 }
146 elsif ($cmd eq "file-exists") {
147 &file_exists($gsdl_cgi, $site);
148 }
149 # cmds not in Greenstone 2:
150 elsif ($gsdl_cgi->greenstone_version() != 2) {
151 if ($cmd eq "download-web-xml-file") {
152 &download_web_xml_file($gsdl_cgi, $username, $timestamp, $site);
153 }
154 elsif ($cmd eq "user-validation") {
155 &user_validation($gsdl_cgi, $username, $timestamp, $site);
156 }
157 elsif ($cmd eq "get-site-names") {
158 &get_site_names($gsdl_cgi, $username, $timestamp, $site);
159 }
160 }
161 else {
162 $gsdl_cgi->generate_error("Unrecognised command: '$cmd'");
163 }
164
165}
166
167
168sub authenticate_user
169{
170 my $gsdl_cgi = shift(@_);
171 my $username = shift(@_);
172 my $collection = shift(@_);
173 my $site = shift(@_);
174
175 # Even if we're not authenticating remove the un and pw arguments, since these can mess up other scripts
176 my $user_password = $gsdl_cgi->clean_param("pw");
177 $gsdl_cgi->delete("pw");
178
179 # Only authenticate if it is enabled
180 # return "all-collections-editor" if (!$authentication_enabled);
181
182 if ((!defined $user_password) || ($user_password =~ m/^\s*$/)) {
183 $gsdl_cgi->generate_error("Authentication failed: no password specified.");
184 }
185
186 my $users_db_content;
187 if($gsdl_cgi->greenstone_version() == 2) {
188 my $etc_directory = &util::filename_cat($ENV{'GSDLHOME'}, "etc");
189 my $users_db_file_path = &util::filename_cat($etc_directory, "users.db");
190
191 # Use db2txt instead of GDBM_File to get the user accounts information
192 $users_db_content = "";
193 open(USERS_DB, "db2txt \"$users_db_file_path\" |");
194 while (<USERS_DB>) {
195 $users_db_content .= $_;
196 }
197 }
198 elsif($gsdl_cgi->greenstone_version() == 3) {
199 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
200
201 my $java = $gsdl_cgi->get_java_path();
202 my $java_gsdl3_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar");
203 my $java_derby_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "derby.jar");
204 my $java_classpath;
205 my $gsdlos = $ENV{'GSDLOS'};
206 if ($gsdlos !~ /windows/){
207 $java_classpath = $java_gsdl3_classpath . ":" . $java_derby_classpath;
208 }else{
209 $java_classpath = $java_gsdl3_classpath . ";" . $java_derby_classpath;
210 }
211 my $java_args = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "etc", "usersDB");
212 $gsdl_cgi->checked_chdir($java_args);
213 my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.util.usersDB2txt \"$java_args\" 2>&1";
214 $users_db_content = `$java_command`;
215 }
216
217 # Get the user account information from the usersDB database
218 my %users_db_data = ();
219 foreach my $users_db_entry (split(/-{70}/, $users_db_content)) {
220 if ($users_db_entry =~ /\n?\[(.+)\]\n/) {
221 $users_db_data{$1} = $users_db_entry;
222 }
223 }
224
225 # Check username
226 my $user_data = $users_db_data{$username};
227 if (!defined $user_data) {
228 $gsdl_cgi->generate_error("Authentication failed: no account for user '$username'.");
229 }
230
231 # Check password
232 my ($valid_user_password) = ($user_data =~ /\<password\>(.*)/);
233 if ($user_password ne $valid_user_password) {
234 $gsdl_cgi->generate_error("Authentication failed: incorrect password.");
235 }
236
237 # Check group
238 my ($user_groups) = ($user_data =~ /\<groups\>(.*)/);
239
240 if ($collection eq "") {
241 # If we're not editing a collection then the user doesn't need to be in a particular group
242 return $user_groups; # Authentication successful
243 }
244
245 foreach my $user_group (split(/\,/, $user_groups)) {
246 # Does this user have access to all collections?
247 if ($user_group eq "all-collections-editor") {
248 return $user_groups; # Authentication successful
249 }
250 # Does this user have access to personal collections, and is this one?
251 if ($user_group eq "personal-collections-editor" && $collection =~ /^$username\-/) {
252 return $user_groups; # Authentication successful
253 }
254 # Does this user have access to this collection
255 if ($user_group eq "$collection-collection-editor") {
256 return $user_groups; # Authentication successful
257 }
258 }
259 $gsdl_cgi->generate_error("Authentication failed: user is not in the required group.");
260}
261
262
263sub lock_collection
264{
265 my $gsdl_cgi = shift(@_);
266 my $username = shift(@_);
267 my $collection = shift(@_);
268 my $site = shift(@_);
269
270 my $steal_lock = $gsdl_cgi->clean_param("steal_lock");
271 $gsdl_cgi->delete("steal_lock");
272
273 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
274 $gsdl_cgi->checked_chdir($collection_directory);
275
276 # Check if a lock file already exists for this collection
277 my $lock_file_name = "gli.lck";
278 if (-e $lock_file_name) {
279 # A lock file already exists... check if it's ours
280 my $lock_file_content = "";
281 open(LOCK_FILE, "<$lock_file_name");
282 while (<LOCK_FILE>) {
283 $lock_file_content .= $_;
284 }
285 close(LOCK_FILE);
286
287 # Pick out the owner of the lock file
288 $lock_file_content =~ /\<User\>(.*?)\<\/User\>/;
289 my $lock_file_owner = $1;
290
291 # The lock file is ours, so there is no problem
292 if ($lock_file_owner eq $username) {
293 return;
294 }
295
296 # The lock file is not ours, so throw an error unless "steal_lock" is set
297 unless (defined $steal_lock) {
298 $gsdl_cgi->generate_error("Collection is locked by: $lock_file_owner");
299 }
300 }
301
302 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
303 my $current_time = sprintf("%02d/%02d/%d %02d:%02d:%02d", $mday, $mon + 1, $year + 1900, $hour, $min, $sec);
304
305 # Create a lock file for us (in the same format as the GLI) and we're done
306 open(LOCK_FILE, ">$lock_file_name");
307 print LOCK_FILE "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
308 print LOCK_FILE "<LockFile>\n";
309 print LOCK_FILE " <User>" . $username . "</User>\n";
310 print LOCK_FILE " <Machine>(Remote)</Machine>\n";
311 print LOCK_FILE " <Date>" . $current_time . "</Date>\n";
312 print LOCK_FILE "</LockFile>\n";
313 close(LOCK_FILE);
314}
315
316
317# ----------------------------------------------------------------------------------------------------
318# ACTIONS
319# ----------------------------------------------------------------------------------------------------
320# This routine won't get called by GS2, so uses the variable site
321sub user_validation{
322 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
323
324 # Users can be in any group to perform this action
325 my $user_err = &authenticate_user($gsdl_cgi, $username, "", $site);
326 if (defined $user_err && $user_err!~ /ERROR/){
327 if ($user_err!~ /ERROR/){
328 #$gsdl_cgi->generate_error("Authentication failed: $username is not valid");
329 $gsdl_cgi->generate_ok($user_err);
330 #print $user_err;
331 }else{
332 $gsdl_cgi->generate_error($user_err);
333 #print "not valid" . $user_err;
334 }
335 }else{
336 $gsdl_cgi->generate_error("Authentication failed: $username is not valid");
337 }
338}
339
340sub check_installation
341{
342 my ($gsdl_cgi) = @_;
343
344 my $installation_ok = 1;
345 my $installation_status = "";
346
347 # Check that Java is installed and accessible
348 my $java = $gsdl_cgi->get_java_path();
349 my $java_command = "\"$java\" -version 2>&1";
350
351 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
352 # directly out to the page
353 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { ##
354 print STDOUT "Content-type:text/plain\n\n";
355 $java_command = "\"$java\" -version";
356 }
357
358 my $java_output = `$java_command`;
359
360 my $java_status = $?;
361 if ($java_status < 0) {
362 # The Java command failed
363 $installation_status = "Java failed -- do you have the Java run-time installed?\n" . $gsdl_cgi->check_java_home() . "\n";
364 $installation_ok = 0;
365 }
366 else {
367 $installation_status = "Java found: $java_output";
368 }
369
370 # Show the values of some important environment variables
371 $installation_status .= "\n";
372 $installation_status .= "GSDL3SRCHOME: " . $ENV{'GSDL3SRCHOME'} . "\n" unless ($gsdl_cgi->greenstone_version() == 2);
373 $installation_status .= "GSDLHOME: " . $ENV{'GSDLHOME'} . "\n";
374 $installation_status .= "GSDLOS: " . $ENV{'GSDLOS'} . "\n";
375 $installation_status .= "JAVA_HOME: " . $ENV{'JAVA_HOME'} . "\n" if defined($ENV{'JAVA_HOME'}); # on GS2, Java's only on the PATH
376 $installation_status .= "PATH: " . $ENV{'PATH'} . "\n";
377
378
379 if ($installation_ok) { ## M. Dewsnip's svn log comment stated that for iis6_mode output needs to go to STDOUT
380 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) {
381 print STDOUT $installation_status . "\nInstallation OK!";
382 } else {
383 $gsdl_cgi->generate_ok_message($installation_status . "\nInstallation OK!");
384 }
385 }
386 else {
387 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) {
388 print STDOUT $installation_status;
389 } else {
390 $gsdl_cgi->generate_error($installation_status);
391 }
392 }
393}
394
395
396sub delete_collection
397{
398 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
399
400 my $collection = $gsdl_cgi->clean_param("c");
401 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
402 $gsdl_cgi->generate_error("No collection specified.");
403 }
404
405 # Ensure the user is allowed to edit this collection
406 &authenticate_user($gsdl_cgi, $username, $collection, $site);
407
408
409 my $collect_directory = $gsdl_cgi->get_collection_dir($site);
410 $gsdl_cgi->checked_chdir($collect_directory);
411
412 # Check that the collection exists
413 if (!-d $collection) {
414 $gsdl_cgi->generate_error("Collection $collection does not exist.");
415 }
416
417 # Make sure the collection isn't locked by someone else
418 &lock_collection($gsdl_cgi, $username, $collection, $site);
419
420 $gsdl_cgi->checked_chdir($collect_directory);
421 $gsdl_cgi->local_rm_r("$collection");
422
423 # Check that the collection was deleted
424 if (-e $collection) {
425 $gsdl_cgi->generate_error("Could not delete collection $collection.");
426 }
427
428 $gsdl_cgi->generate_ok_message("Collection $collection deleted successfully.");
429}
430
431
432sub delete_collection_file
433{
434 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
435
436 my $collection = $gsdl_cgi->clean_param("c");
437 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
438 $gsdl_cgi->generate_error("No collection specified.");
439 }
440 my $file = $gsdl_cgi->clean_param("file");
441 if ((!defined $file) || ($file =~ m/^\s*$/)) {
442 $gsdl_cgi->generate_error("No file specified.");
443 }
444 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
445
446 # Make sure we don't try to delete anything outside the collection
447 if ($file =~ /\.\./) {
448 $gsdl_cgi->generate_error("Illegal file specified.");
449 }
450
451 # Ensure the user is allowed to edit this collection
452 &authenticate_user($gsdl_cgi, $username, $collection, $site);
453
454 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
455 if (!-d $collection_directory){ ## wasn't there in gs2, ok_msg or error_msg?
456 $gsdl_cgi->generate_ok_message("Directory $collection_directory does not exist.");
457 die;
458 }
459
460 $gsdl_cgi->checked_chdir($collection_directory);
461
462 # Make sure the collection isn't locked by someone else
463 &lock_collection($gsdl_cgi, $username, $collection, $site);
464
465 # Check that the collection file exists
466 if (!-e $file) { ## original didn't have 'die', but it was an ok message
467 $gsdl_cgi->generate_ok_message("Collection file $file does not exist.");
468 die;
469 }
470 $gsdl_cgi->local_rm_r("$file");
471
472 # Check that the collection file was deleted
473 if (-e $file) {
474 $gsdl_cgi->generate_error("Could not delete collection file $file.");
475 }
476
477 $gsdl_cgi->generate_ok_message("Collection file $file deleted successfully.");
478}
479
480
481sub download_collection
482{
483 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
484
485 my $collection = $gsdl_cgi->clean_param("c");
486 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
487 $gsdl_cgi->generate_error("No collection specified.");
488 }
489
490 # Ensure the user is allowed to edit this collection
491 &authenticate_user($gsdl_cgi, $username, $collection, $site);
492
493 my $collect_directory = $gsdl_cgi->get_collection_dir($site);
494 $gsdl_cgi->checked_chdir($collect_directory);
495
496 # Check that the collection exists
497 if (!-d $collection) {
498 $gsdl_cgi->generate_ok_message("Collection $collection does not exist."); ## original had an error msg (from where it would die)
499 die;
500 }
501
502 # Make sure the collection isn't locked by someone else
503 &lock_collection($gsdl_cgi, $username, $collection, $site);
504
505 # Zip up the collection
506 my $java = $gsdl_cgi->get_java_path();
507 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
508 my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-" . $timestamp . ".zip");
509 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\"";
510 if($gsdl_cgi->greenstone_version() != 2) {
511 $java_args .= " gsdl3"; ## must this be done elsewhere as well?
512 }
513 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args";
514
515 my $java_output = `$java_command`;
516 my $java_status = $?;
517 if ($java_status > 0) {
518 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
519 }
520
521 # Check that the zip file was created successfully
522 if (!-e $zip_file_path || -z $zip_file_path) {
523 $gsdl_cgi->generate_error("Collection zip file $zip_file_path could not be created.");
524 }
525
526 &put_file($gsdl_cgi, $zip_file_path, "application/zip"); # file is transferred to client
527 unlink("$zip_file_path") unless $debugging_enabled; # deletes the local intermediate zip file
528}
529
530
531sub download_collection_archives
532{
533 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
534
535 my $collection = $gsdl_cgi->clean_param("c");
536 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
537 $gsdl_cgi->generate_error("No collection specified.");
538 }
539
540 # Ensure the user is allowed to edit this collection
541 &authenticate_user($gsdl_cgi, $username, $collection, $site);
542
543 my $collect_directory = $gsdl_cgi->get_collection_dir($site);
544 $gsdl_cgi->checked_chdir($collect_directory);
545
546 # Check that the collection archives exist
547 if (!-d &util::filename_cat($collection, "archives")) {
548 $gsdl_cgi->generate_error("Collection archives do not exist.");
549 }
550
551 # Make sure the collection isn't locked by someone else
552 &lock_collection($gsdl_cgi, $username, $collection, $site);
553
554 # Zip up the collection archives
555 my $java = $gsdl_cgi->get_java_path();
556 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
557 my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-archives-" . $timestamp . ".zip");
558 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\"";
559 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";
560
561 my $java_output = `$java_command`;
562 my $java_status = $?;
563 if ($java_status > 0) {
564 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
565 }
566
567 # Check that the zip file was created successfully
568 if (!-e $zip_file_path || -z $zip_file_path) {
569 $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
570 }
571
572 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
573 unlink("$zip_file_path") unless $debugging_enabled;
574}
575
576
577# Collection locking unnecessary because this action isn't related to a particular collection
578sub download_collection_configurations
579{
580 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
581
582 # Users can be in any group to perform this action
583 my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site);
584
585 my $collect_directory = $gsdl_cgi->get_collection_dir($site);
586 $gsdl_cgi->checked_chdir($collect_directory);
587
588 # Zip up the collection configurations
589 my $java = $gsdl_cgi->get_java_path();
590 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
591 my $zip_file_path = &util::filename_cat($collect_directory, "collection-configurations-" . $timestamp . ".zip");
592 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$username\" \"$user_groups\"";
593 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args";
594 my $java_output = `$java_command`;
595 my $java_status = $?;
596 if ($java_status > 0) {
597 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
598 }
599
600 # Check that the zip file was created successfully
601 if (!-e $zip_file_path || -z $zip_file_path) {
602 $gsdl_cgi->generate_error("Collection configurations zip file $zip_file_path could not be created.");
603 }
604
605 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
606 unlink("$zip_file_path") unless $debugging_enabled;
607}
608
609# Method that will check if the given file exists
610# No error message: all messages generated are OK messages
611# This method will simply state whether the file exists or does not exist.
612sub file_exists
613{
614 my ($gsdl_cgi, $site) = @_;
615
616 my $collection = $gsdl_cgi->clean_param("c");
617 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
618 $gsdl_cgi->generate_error("No collection specified.");
619 }
620 my $file = $gsdl_cgi->clean_param("file");
621 if ((!defined $file) || ($file =~ m/^\s*$/)) {
622 $gsdl_cgi->generate_error("No file specified.");
623 }
624 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
625
626 # Not necessary: checking whether the user is authenticated to query existence of the file
627 #&authenticate_user($gsdl_cgi, $username, $collection);
628
629 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
630 $gsdl_cgi->checked_chdir($collection_directory); # cd into the directory of that collection
631
632 # Check that the collection file exists
633 if (-e $file) {
634 $gsdl_cgi->generate_ok_message("File $file exists.");
635 } else {
636 $gsdl_cgi->generate_ok_message("File $file does not exist.");
637 }
638}
639
640sub download_collection_file
641{
642 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
643
644 my $collection = $gsdl_cgi->clean_param("c");
645 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
646 $gsdl_cgi->generate_error("No collection specified.");
647 }
648 my $file = $gsdl_cgi->clean_param("file");
649 if ((!defined $file) || ($file =~ m/^\s*$/)) {
650 $gsdl_cgi->generate_error("No file specified.");
651 }
652 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
653
654 # Make sure we don't try to download anything outside the collection
655 if ($file =~ /\.\./) {
656 $gsdl_cgi->generate_error("Illegal file specified.");
657 }
658
659 # Ensure the user is allowed to edit this collection
660 &authenticate_user($gsdl_cgi, $username, $collection, $site);
661
662 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
663 $gsdl_cgi->checked_chdir($collection_directory);
664
665 # Check that the collection file exists
666 if (!-e $file) {
667 $gsdl_cgi->generate_ok_message("Collection file $file does not exist.");
668 die;
669 }
670
671 # Make sure the collection isn't locked by someone else
672 &lock_collection($gsdl_cgi, $username, $collection, $site);
673
674 # Zip up the collection file
675 my $java = $gsdl_cgi->get_java_path();
676 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
677 my $zip_file_path = &util::filename_cat($collection_directory, $collection . "-file-" . $timestamp . ".zip");
678 my $java_args = "\"$zip_file_path\" \"$collection_directory\" \"$file\"";
679 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
680
681 my $java_output = `$java_command`;
682 my $java_status = $?;
683 if ($java_status > 0) {
684 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
685 }
686
687 # Check that the zip file was created successfully
688 if (!-e $zip_file_path || -z $zip_file_path) {
689 $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
690 }
691
692 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
693 unlink("$zip_file_path") unless $debugging_enabled;
694}
695
696# download web.xml from the server
697sub download_web_xml_file
698{
699 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
700
701 # Users can be in any group to perform this action
702 my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site);
703
704 my $file = $gsdl_cgi->clean_param("file");
705 if ((!defined $file) || ($file =~ m/^\s*$/)) {
706 $gsdl_cgi->generate_error("No file specified.");
707 }
708 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
709
710 # Make sure we don't try to download anything else
711 if ($file =~ /\.\./) {
712 $gsdl_cgi->generate_error("Illegal file specified.");
713 }
714
715 my $web_inf_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "WEB-INF");
716 $gsdl_cgi->checked_chdir($web_inf_directory);
717
718 # Check that the collection file exists
719 if (!-e $file) {
720 $gsdl_cgi->generate_error("file $file does not exist.");
721 }
722
723 # Zip up the collection file
724 my $java = $gsdl_cgi->get_java_path();
725 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
726 my $zip_file_path = &util::filename_cat($web_inf_directory, "webxml" . $timestamp . ".zip");
727 my $java_args = "\"$zip_file_path\" \"$web_inf_directory\" \"$file\"";
728 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
729 my $java_output = `$java_command`;
730
731 my $java_status = $?;
732 if ($java_status > 0) {
733 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
734 }
735
736 # Check that the zip file was created successfully
737 if (!-e $zip_file_path || -z $zip_file_path) {
738 $gsdl_cgi->generate_error("web.xml zip file $zip_file_path could not be created.");
739 }
740
741 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
742
743 unlink("$zip_file_path") unless $debugging_enabled;
744}
745
746# Collection locking unnecessary because this action isn't related to a particular collection
747sub get_script_options
748{
749 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
750
751 my $script = $gsdl_cgi->clean_param("script");
752 if ((!defined $script) || ($script =~ m/^\s*$/)) {
753 $gsdl_cgi->generate_error("No script specified.");
754 }
755 $gsdl_cgi->delete("script");
756
757 # Users can be in any group to perform this action
758 &authenticate_user($gsdl_cgi, $username, "", $site);
759 $gsdl_cgi->delete("ts"); ## two lines from GS3 version, doesn't seem to harm GS2
760 $gsdl_cgi->delete("pw");
761
762
763 my $perl_args = "";
764 if ($script eq "classinfo.pl") {
765 $perl_args = $gsdl_cgi->clean_param("classifier") || "";
766 $gsdl_cgi->delete("classifier");
767 }
768 if ($script eq "pluginfo.pl") {
769 $perl_args = $gsdl_cgi->clean_param("plugin") || "";
770 $gsdl_cgi->delete("plugin");
771 }
772
773 foreach my $cgi_arg_name ($gsdl_cgi->param) {
774 my $cgi_arg_value = $gsdl_cgi->clean_param($cgi_arg_name) || "";
775 $cgi_arg_value = $gsdl_cgi->safe_val($cgi_arg_value);
776 if ($cgi_arg_value eq "") {
777 $perl_args = "-$cgi_arg_name " . $perl_args;
778 }
779 else {
780 $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
781 }
782 }
783
784
785 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
786 # directly out to the page
787 print STDOUT "Content-type:text/plain\n\n";
788 my $perl_command;
789 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2)
790 {
791 $perl_command = "perl -S $script $perl_args";
792 } else {
793 $perl_command = "perl -S $script $perl_args 2>&1";
794 }
795
796 my $perl_output = `$perl_command`;
797 my $perl_status = $?;
798 if ($perl_status > 0) {
799 $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\n$perl_output\nExit status: " . ($perl_status / 256));
800 }
801
802 if (defined($perl_output))
803 {
804 print STDOUT $perl_output;
805 }
806}
807
808# get the names of all sites available on the server
809sub get_site_names
810{
811 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
812 my $sites_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites");
813
814 my @sites_dir;
815 my @site_dir;
816
817 $gsdl_cgi->checked_chdir($sites_directory);
818 opendir(DIR, $sites_directory);
819 @sites_dir= readdir(DIR);
820 my $sites_dir;
821 my $sub_dir_file;
822
823 print STDOUT "Content-type:text/plain\n\n";
824 foreach $sites_dir(@sites_dir)
825 {
826 if (!(($sites_dir eq ".") || ($sites_dir eq "..") || ($sites_dir eq "CVS")))
827 {
828 my $site_dir_path= &util::filename_cat($sites_directory,$sites_dir);
829 $gsdl_cgi->checked_chdir($site_dir_path);
830 opendir(DIR,$site_dir_path);
831 @site_dir=readdir(DIR);
832 closedir(DIR);
833
834 foreach $sub_dir_file(@site_dir)
835 {
836 if ($sub_dir_file eq "siteConfig.xml"){
837 print STDOUT "$sites_dir" . "-----";
838 }
839 }
840 }
841 }
842
843}
844
845sub move_collection_file
846{
847 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
848
849 my $collection = $gsdl_cgi->clean_param("c");
850 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
851 $gsdl_cgi->generate_error("No collection specified.");
852 }
853 my $source_file = $gsdl_cgi->clean_param("source");
854 if ((!defined $source_file) || ($source_file =~ m/^\s*$/)) {
855 $gsdl_cgi->generate_error("No source file specified.");
856 }
857 $source_file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
858 my $target_file = $gsdl_cgi->clean_param("target");
859 if ((!defined $target_file) || ($target_file =~ m/^\s*$/)) {
860 $gsdl_cgi->generate_error("No target file specified.");
861 }
862 $target_file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
863
864 # Make sure we don't try to move anything outside the collection
865 if ($source_file =~ /\.\./ || $target_file =~ /\.\./) {
866 $gsdl_cgi->generate_error("Illegal file specified.");
867 }
868
869 # Ensure the user is allowed to edit this collection
870 &authenticate_user($gsdl_cgi, $username, $collection, $site);
871
872 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
873 $gsdl_cgi->checked_chdir($collection_directory);
874
875 # Check that the collection source file exists
876 if (!-e $source_file) {
877 $gsdl_cgi->generate_error("Collection file $source_file does not exist.");
878 }
879
880 # Make sure the collection isn't locked by someone else
881 &lock_collection($gsdl_cgi, $username, $collection, $site);
882
883 &util::mv($source_file, $target_file);
884
885 # Check that the collection source file was moved
886 if (-e $source_file || !-e $target_file) {
887 $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file."); # dies
888 }
889
890 $gsdl_cgi->generate_ok_message("Collection file $source_file moved to $target_file successfully.");
891}
892
893
894sub new_collection_directory
895{
896 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
897
898 my $collection = $gsdl_cgi->clean_param("c");
899 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
900 $gsdl_cgi->generate_error("No collection specified.");
901 }
902 my $directory = $gsdl_cgi->clean_param("directory");
903 if ((!defined $directory) || ($directory =~ m/^\s*$/)) {
904 $gsdl_cgi->generate_error("No directory specified.");
905 }
906 $directory =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
907
908 # Make sure we don't try to create anything outside the collection
909 if ($directory =~ /\.\./) {
910 $gsdl_cgi->generate_error("Illegal directory specified.");
911 }
912
913 # Ensure the user is allowed to edit this collection
914 &authenticate_user($gsdl_cgi, $username, $collection, $site);
915
916 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
917 $gsdl_cgi->checked_chdir($collection_directory);
918
919 # Check that the collection directory doesn't already exist
920 # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicity
921 # try to create the import directory
922## log -r13497 for GS2's gliserver.pl, Katherine Don explains:
923# "commented out checking for existence of a directory in new_collection_directory
924# as it throws an error which we don't want"
925 if($gsdl_cgi->greenstone_version() != 2 && -d $directory) {
926 $gsdl_cgi->generate_error("Collection directory $directory already exists.");
927 }
928
929 # Make sure the collection isn't locked by someone else
930 &lock_collection($gsdl_cgi, $username, $collection, $site);
931
932 &util::mk_dir($directory);
933
934 # Check that the collection directory was created
935 if (!-d $directory) {
936 $gsdl_cgi->generate_error("Could not create collection directory $directory.");
937 }
938
939 $gsdl_cgi->generate_ok_message("Collection directory $directory created successfully.");
940}
941
942
943sub run_script
944{
945 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
946
947 my $script = $gsdl_cgi->clean_param("script");
948 if ((!defined $script) || ($script =~ m/^\s*$/)) {
949 $gsdl_cgi->generate_error("No script specified.");
950 }
951 $gsdl_cgi->delete("script");
952 my $collection = $gsdl_cgi->clean_param("c");
953 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
954 $gsdl_cgi->generate_error("No collection specified.");
955 }
956 $gsdl_cgi->delete("c");
957
958 # confuse other, so delete timestamp
959 $gsdl_cgi->delete("ts");
960
961 # Ensure the user is allowed to edit this collection
962 &authenticate_user($gsdl_cgi, $username, $collection, $site);
963
964 # Make sure the collection isn't locked by someone else (unless we're running mkcol.pl, of course)
965 &lock_collection($gsdl_cgi, $username, $collection, $site) unless ($script eq "mkcol.pl");
966
967 # Last argument is the collection name, except for explode_metadata_database.pl and
968 # replace_srcdoc_with_html (where there's a "file" option followed by the filename. These two preceed the collection name)
969 my $perl_args = $collection;
970 if ($script eq "explode_metadata_database.pl" || $script eq "replace_srcdoc_with_html.pl") {
971 # Last argument is the file to be exploded or it is the file to be replaced with its html version
972 my $file = $gsdl_cgi->clean_param("file");
973 if ((!defined $file) || ($file =~ m/^\s*$/)) {
974 $gsdl_cgi->generate_error("No file specified.");
975 }
976 $gsdl_cgi->delete("file");
977 $file =~ s/ /\\ /g; # escape all spaces in filename with a backslash, i.e. "\ ".
978 $perl_args = $file;
979 }
980
981 foreach my $cgi_arg_name ($gsdl_cgi->param) {
982 my $cgi_arg_value = $gsdl_cgi->safe_val($gsdl_cgi->clean_param($cgi_arg_name));
983 if ($cgi_arg_value eq "") {
984 $perl_args = "-$cgi_arg_name " . $perl_args;
985 }
986 else {
987 $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
988 }
989 }
990
991 if (($script eq "import.pl") || ($script eq "buildcol.pl") || ($script eq "mkcol.pl")) { # || ($script eq "schedule.pl")
992 my $collect_directory = $gsdl_cgi->get_collection_dir($site);
993 $perl_args = $perl_args . " -collectdir " . $collect_directory;
994 }
995
996 my $perl_command = "perl -S $script $perl_args 2>&1";
997 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
998 # directly out to the page
999 if($gsdl_cgi->greenstone_version() == 2 && $iis6_mode)
1000 {
1001 $perl_command = "perl -S $script $perl_args";
1002 }
1003 if (!open(PIN, "$perl_command |")) {
1004 $gsdl_cgi->generate_error("Unable to execute command: $perl_command");
1005 }
1006
1007 print STDOUT "Content-type:text/plain\n\n";
1008 print "$perl_command \n";
1009
1010 while (defined (my $perl_output_line = <PIN>)) {
1011 print STDOUT $perl_output_line;
1012 }
1013 close(PIN);
1014
1015 my $perl_status = $?;
1016 if ($perl_status > 0) {
1017 $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\nExit status: " . ($perl_status / 256));
1018 }
1019 elsif ($mail_enabled) {
1020 if ($script eq "buildcol.pl") {
1021 &send_mail($gsdl_cgi, "Remote Greenstone building event", "Build of collection '$collection' complete.");
1022 }
1023 }
1024}
1025
1026sub upload_collection_file
1027{
1028 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
1029
1030 my $collection = $gsdl_cgi->clean_param("c");
1031 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
1032 $gsdl_cgi->generate_error("No collection specified.");
1033 }
1034 my $file = $gsdl_cgi->clean_param("file");
1035 if ((!defined $file) || ($file =~ m/^\s*$/)) {
1036 $gsdl_cgi->generate_error("No file specified.");
1037 }
1038 my $directory = $gsdl_cgi->clean_param("directory") || "";
1039 $directory =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
1040 my $zip = $gsdl_cgi->clean_param("zip");
1041
1042 # Make sure we don't try to upload anything outside the collection
1043 if ($file =~ /\.\./) {
1044 $gsdl_cgi->generate_error("Illegal file specified.");
1045 }
1046 if ($directory =~ /\.\./) {
1047 $gsdl_cgi->generate_error("Illegal directory specified.");
1048 }
1049
1050 # Ensure the user is allowed to edit this collection
1051 if($gsdl_cgi->greenstone_version() == 2) { ## Quan commented this out for GS3 in r14325
1052 &authenticate_user($gsdl_cgi, $username, $collection, $site); # site will be undefined for GS2, of course
1053 }
1054
1055 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
1056 $gsdl_cgi->checked_chdir($collection_directory);
1057
1058 # Make sure the collection isn't locked by someone else
1059 &lock_collection($gsdl_cgi, $username, $collection, $site);
1060
1061 my $directory_path = &util::filename_cat($collection_directory, $directory);
1062 if (!-d $directory_path) {
1063 &util::mk_dir($directory_path);
1064 if (!-d $directory_path) {
1065 $gsdl_cgi->generate_error("Could not create directory $directory_path.");
1066 }
1067 }
1068
1069 #my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
1070 my $file_path = "";
1071 if($gsdl_cgi->greenstone_version() == 2) {
1072 $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
1073 } else {
1074 $file_path = &util::filename_cat($directory_path, $file);
1075 }
1076
1077 if (!open(FOUT, ">$file_path")) {
1078 print STDERR "Unable to write file $file_path\n";
1079 $gsdl_cgi->generate_error("Unable to write file $file_path");
1080 }
1081
1082 # Read the uploaded data and write it out to file
1083 my $buf;
1084 my $num_bytes = 0;
1085 binmode(FOUT);
1086 if($gsdl_cgi->greenstone_version() == 2) { ##
1087 # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be
1088 # completely incapable of working this out otherwise (causing the old code to crash)
1089 my $num_bytes_remaining = $gsdl_cgi->clean_param("fs");
1090 my $bytes_to_read = $num_bytes_remaining;
1091 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }
1092
1093 while (read(STDIN, $buf, $bytes_to_read) > 0) {
1094 print FOUT $buf;
1095 $num_bytes += length($buf);
1096 $num_bytes_remaining -= length($buf);
1097 $bytes_to_read = $num_bytes_remaining;
1098 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }
1099 }
1100 } else { # GS3 and later
1101 my $bread;
1102 my $fh = $gsdl_cgi->clean_param("uploaded_file");
1103
1104 if (!defined $fh) {
1105 print STDERR "ERROR. Filehandle undefined. No file uploaded onto GS3 server.\n";
1106 $gsdl_cgi->generate_error("ERROR. Filehandle undefined. No file uploaded (GS3 server).");
1107 } else {
1108 while ($bread=read($fh, $buf, 1024)) {
1109 print FOUT $buf;
1110 }
1111 }
1112 }
1113 close(FOUT);
1114
1115 # If we have downloaded a zip file, unzip it
1116 if (defined $zip) {
1117 my $java = $gsdl_cgi->get_java_path();
1118 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
1119 my $java_args = "\"$file_path\" \"$directory_path\"";
1120 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";
1121
1122 my $java_output = `$java_command`;
1123 my $java_status = $?;
1124
1125 # Remove the zip file once we have unzipped it, since it is an intermediate file only
1126 unlink("$file_path") unless $debugging_enabled;
1127
1128 if ($java_status > 0) {
1129 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); # dies
1130 }
1131 }
1132
1133 $gsdl_cgi->generate_ok_message("Collection file $file uploaded successfully.");
1134}
1135
1136sub put_file
1137{
1138 my $gsdl_cgi = shift(@_);
1139 my $file_path = shift(@_);
1140 my $content_type = shift(@_);
1141
1142 if(!defined $content_type) { ##
1143 $content_type = "application/zip";
1144 }
1145
1146 if (open(PIN, "<$file_path")) {
1147 print STDOUT "Content-type:$content_type\n\n"; ## For GS3: "Content-type:application/zip\n\n";
1148 my $buf;
1149 my $num_bytes = 0;
1150 binmode(PIN);
1151 while (read(PIN, $buf, 1024) > 0) {
1152 print STDOUT $buf;
1153 $num_bytes += length($buf);
1154 }
1155
1156 close(PIN);
1157 }
1158 else {
1159 $gsdl_cgi->generate_error("Unable to read file $file_path\n $!");
1160 }
1161}
1162
1163
1164sub send_mail
1165{
1166 my $gsdl_cgi = shift(@_);
1167 my $mail_subject = shift(@_);
1168 my $mail_content = shift(@_);
1169
1170 my $sendmail_command = "perl -S sendmail.pl";
1171 $sendmail_command .= " -to \"" . $mail_to_address . "\"";
1172 $sendmail_command .= " -from \"" . $mail_from_address . "\"";
1173 $sendmail_command .= " -smtp \"" . $mail_smtp_server . "\"";
1174 $sendmail_command .= " -subject \"" . $mail_subject . "\"";
1175
1176 if (!open(POUT, "| $sendmail_command")) {
1177 $gsdl_cgi->generate_error("Unable to execute command: $sendmail_command");
1178 }
1179 print POUT $mail_content . "\n";
1180 close(POUT);
1181}
1182
1183sub greenstone_server_version
1184{
1185 my $gsdl_cgi = shift(@_);
1186 my $version = $gsdl_cgi->greenstone_version();
1187 $gsdl_cgi->generate_ok_message("Greenstone server version is: $version\n");
1188}
1189
1190sub get_library_url_suffix
1191{
1192 my $gsdl_cgi = shift(@_);
1193 my $library_url = $gsdl_cgi->library_url_suffix();
1194 $gsdl_cgi->generate_ok_message("Greenstone library URL suffix is: $library_url\n");
1195}
1196
1197&main();
Note: See TracBrowser for help on using the repository browser.