source: gsdl/trunk/cgi-bin/gliserver.pl@ 19137

Last change on this file since 19137 was 19137, checked in by ak19, 15 years ago

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