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

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

Merged GS2's gliserver.pl and gsdlCGI.pm with GS3's gliserver4gs3.pl and gsdlCGI4gs3.pm and moved them into gs2's svn trunk (previously still in GS3's svn trunk). Now there's one set of gliserver files that will work for both GS2 and GS3 remote Greenstone servers.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 42.6 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 &upload_collection_file($gsdl_cgi, $username, $timestamp, $site);
144 }
145 elsif ($cmd eq "file-exists") {
146 &file_exists($gsdl_cgi, $site);
147 }
148 # cmds not in Greenstone 2:
149 elsif ($gsdl_cgi->greenstone_version() != 2) {
150 if ($cmd eq "download-web-xml-file") {
151 &download_web_xml_file($gsdl_cgi, $username, $timestamp, $site);
152 }
153 elsif ($cmd eq "user-validation") {
154 &user_validation($gsdl_cgi, $username, $timestamp, $site);
155 }
156 elsif ($cmd eq "get-site-names") {
157 &get_site_names($gsdl_cgi, $username, $timestamp, $site);
158 }
159 }
160 else {
161 $gsdl_cgi->generate_error("Unrecognised command: '$cmd'");
162 }
163
164}
165
166
167sub authenticate_user
168{
169 my $gsdl_cgi = shift(@_);
170 my $username = shift(@_);
171 my $collection = shift(@_);
172 my $site = shift(@_);
173
174 # Even if we're not authenticating remove the un and pw arguments, since these can mess up other scripts
175 my $user_password = $gsdl_cgi->clean_param("pw");
176 $gsdl_cgi->delete("pw");
177
178 # Only authenticate if it is enabled
179 # return "all-collections-editor" if (!$authentication_enabled);
180
181 if ((!defined $user_password) || ($user_password =~ m/^\s*$/)) {
182 $gsdl_cgi->generate_error("Authentication failed: no password specified.");
183 }
184
185 my $users_db_content;
186 if($gsdl_cgi->greenstone_version() == 2) {
187 my $etc_directory = &util::filename_cat($ENV{'GSDLHOME'}, "etc");
188 my $users_db_file_path = &util::filename_cat($etc_directory, "users.db");
189
190 # Use db2txt instead of GDBM_File to get the user accounts information
191 $users_db_content = "";
192 open(USERS_DB, "db2txt \"$users_db_file_path\" |");
193 while (<USERS_DB>) {
194 $users_db_content .= $_;
195 }
196 }
197 elsif($gsdl_cgi->greenstone_version() == 3) {
198 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
199
200 my $java = $gsdl_cgi->get_java_path();
201 my $java_gsdl3_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar");
202 my $java_derby_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "derby.jar");
203 my $java_classpath;
204 my $gsdlos = $ENV{'GSDLOS'};
205 if ($gsdlos !~ m/windows/){
206 $java_classpath = $java_gsdl3_classpath . ":" . $java_derby_classpath;
207 }else{
208 $java_classpath = $java_gsdl3_classpath . ";" . $java_derby_classpath;
209 }
210 my $java_args = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "etc", "usersDB");
211 $gsdl_cgi->checked_chdir($java_args);
212 my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.util.usersDB2txt \"$java_args\" 2>&1";
213 $users_db_content = `$java_command`;
214 }
215
216 # Get the user account information from the usersDB database
217 my %users_db_data = ();
218 foreach my $users_db_entry (split(/-{70}/, $users_db_content)) {
219 if ($users_db_entry =~ m/\n?\[(.+)\]\n/) {
220 $users_db_data{$1} = $users_db_entry;
221 }
222 }
223
224 # Check username
225 my $user_data = $users_db_data{$username};
226 if (!defined $user_data) {
227 $gsdl_cgi->generate_error("Authentication failed: no account for user '$username'.");
228 }
229
230 # Check password
231 my ($valid_user_password) = ($user_data =~ m/\<password\>(.*)/);
232 if ($user_password ne $valid_user_password) {
233 $gsdl_cgi->generate_error("Authentication failed: incorrect password.");
234 }
235
236 # Check group
237 my ($user_groups) = ($user_data =~ m/\<groups\>(.*)/);
238
239 if ($collection eq "") {
240 # If we're not editing a collection then the user doesn't need to be in a particular group
241 return $user_groups; # Authentication successful
242 }
243
244 foreach my $user_group (split(/\,/, $user_groups)) {
245 # Does this user have access to all collections?
246 if ($user_group eq "all-collections-editor") {
247 return $user_groups; # Authentication successful
248 }
249 # Does this user have access to personal collections, and is this one?
250 if ($user_group eq "personal-collections-editor" && $collection =~ m/^$username\-/) {
251 return $user_groups; # Authentication successful
252 }
253 # Does this user have access to this collection
254 if ($user_group eq "$collection-collection-editor") {
255 return $user_groups; # Authentication successful
256 }
257 }
258 $gsdl_cgi->generate_error("Authentication failed: user is not in the required group.");
259}
260
261
262sub lock_collection
263{
264 my $gsdl_cgi = shift(@_);
265 my $username = shift(@_);
266 my $collection = shift(@_);
267 my $site = shift(@_);
268
269 my $steal_lock = $gsdl_cgi->clean_param("steal_lock");
270 $gsdl_cgi->delete("steal_lock");
271
272 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
273 $gsdl_cgi->checked_chdir($collection_directory);
274
275 # Check if a lock file already exists for this collection
276 my $lock_file_name = "gli.lck";
277 if (-e $lock_file_name) {
278 # A lock file already exists... check if it's ours
279 my $lock_file_content = "";
280 open(LOCK_FILE, "<$lock_file_name");
281 while (<LOCK_FILE>) {
282 $lock_file_content .= $_;
283 }
284 close(LOCK_FILE);
285
286 # Pick out the owner of the lock file
287 $lock_file_content =~ m/\<User\>(.*?)\<\/User\>/;
288 my $lock_file_owner = $1;
289
290 # The lock file is ours, so there is no problem
291 if ($lock_file_owner eq $username) {
292 return;
293 }
294
295 # The lock file is not ours, so throw an error unless "steal_lock" is set
296 unless (defined $steal_lock) {
297 $gsdl_cgi->generate_error("Collection is locked by: $lock_file_owner");
298 }
299 }
300
301 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
302 my $current_time = sprintf("%02d/%02d/%d %02d:%02d:%02d", $mday, $mon + 1, $year + 1900, $hour, $min, $sec);
303
304 # Create a lock file for us (in the same format as the GLI) and we're done
305 open(LOCK_FILE, ">$lock_file_name");
306 print LOCK_FILE "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
307 print LOCK_FILE "<LockFile>\n";
308 print LOCK_FILE " <User>" . $username . "</User>\n";
309 print LOCK_FILE " <Machine>(Remote)</Machine>\n";
310 print LOCK_FILE " <Date>" . $current_time . "</Date>\n";
311 print LOCK_FILE "</LockFile>\n";
312 close(LOCK_FILE);
313}
314
315
316# ----------------------------------------------------------------------------------------------------
317# ACTIONS
318# ----------------------------------------------------------------------------------------------------
319# This routine, which uses the variable site, won't get called by GS2,
320sub user_validation{
321 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
322
323 # Users can be in any group to perform this action
324 my $user_err = &authenticate_user($gsdl_cgi, $username, "", $site);
325 if (defined $user_err && $user_err!~ m/ERROR/){
326 if ($user_err!~ m/ERROR/){
327 #$gsdl_cgi->generate_error("Authentication failed: $username is not valid");
328 $gsdl_cgi->generate_ok($user_err);
329 #print $user_err;
330 }else{
331 $gsdl_cgi->generate_error($user_err);
332 #print "not valid" . $user_err;
333 }
334 }else{
335 $gsdl_cgi->generate_error("Authentication failed: $username is not valid");
336 }
337}
338
339sub check_installation
340{
341 my ($gsdl_cgi) = @_;
342
343 my $installation_ok = 1;
344 my $installation_status = "";
345
346 # Check that Java is installed and accessible
347 my $java = $gsdl_cgi->get_java_path();
348 my $java_command = "\"$java\" -version 2>&1";
349
350 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
351 # directly out to the page
352 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { ##
353 print STDOUT "Content-type:text/plain\n\n";
354 $java_command = "\"$java\" -version";
355 }
356
357 my $java_output = `$java_command`;
358
359 my $java_status = $?;
360 if ($java_status < 0) {
361 # The Java command failed
362 $installation_status = "Java failed -- do you have the Java run-time installed?\n" . $gsdl_cgi->check_java_home() . "\n";
363 $installation_ok = 0;
364 }
365 else {
366 $installation_status = "Java found: $java_output";
367 }
368
369 # Show the values of some important environment variables
370 $installation_status .= "\n";
371 if($gsdl_cgi->greenstone_version() != 2) {
372 $installation_status .= "GSDL3SRCHOME: " . $ENV{'GSDL3SRCHOME'} . "\n";
373 $installation_status .= "GSDL3HOME: " . $ENV{'GSDL3HOME'} . "\n";
374 }
375 $installation_status .= "GSDLHOME: " . $ENV{'GSDLHOME'} . "\n";
376 $installation_status .= "GSDLOS: " . $ENV{'GSDLOS'} . "\n";
377 $installation_status .= "JAVA_HOME: " . $ENV{'JAVA_HOME'} . "\n" if defined($ENV{'JAVA_HOME'}); # on GS2, Java's only on the PATH
378 $installation_status .= "PATH: " . $ENV{'PATH'} . "\n";
379 if(defined $ENV{'FEDORA_VERSION'}) { # not using FLI unless version set
380 $installation_status .= "FEDORA_HOME: ".$ENV{'FEDORA_HOME'} . "\n";
381 $installation_status .= "FEDORA_VERSION: ".$ENV{'FEDORA_VERSION'};
382 }
383
384 if ($installation_ok) { ## M. Dewsnip's svn log comment stated that for iis6_mode output needs to go to STDOUT
385 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) {
386 print STDOUT $installation_status . "\nInstallation OK!";
387 } else {
388 $gsdl_cgi->generate_ok_message($installation_status . "\nInstallation OK!");
389 }
390 }
391 else {
392 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) {
393 print STDOUT $installation_status;
394 } else {
395 $gsdl_cgi->generate_error($installation_status);
396 }
397 }
398}
399
400
401sub delete_collection
402{
403 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
404
405 my $collection = $gsdl_cgi->clean_param("c");
406 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
407 $gsdl_cgi->generate_error("No collection specified.");
408 }
409
410 # Ensure the user is allowed to edit this collection
411 &authenticate_user($gsdl_cgi, $username, $collection, $site);
412
413
414 my $collect_directory = $gsdl_cgi->get_collection_dir($site);
415 $gsdl_cgi->checked_chdir($collect_directory);
416
417 # Check that the collection exists
418 if (!-d $collection) {
419 $gsdl_cgi->generate_error("Collection $collection does not exist.");
420 }
421
422 # Make sure the collection isn't locked by someone else
423 &lock_collection($gsdl_cgi, $username, $collection, $site);
424
425 $gsdl_cgi->checked_chdir($collect_directory);
426 $gsdl_cgi->local_rm_r("$collection");
427
428 # Check that the collection was deleted
429 if (-e $collection) {
430 $gsdl_cgi->generate_error("Could not delete collection $collection.");
431 }
432
433 $gsdl_cgi->generate_ok_message("Collection $collection deleted successfully.");
434}
435
436
437sub delete_collection_file
438{
439 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
440
441 my $collection = $gsdl_cgi->clean_param("c");
442 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
443 $gsdl_cgi->generate_error("No collection specified.");
444 }
445 my $file = $gsdl_cgi->clean_param("file");
446 if ((!defined $file) || ($file =~ m/^\s*$/)) {
447 $gsdl_cgi->generate_error("No file specified.");
448 }
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 =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
630
631 # Not necessary: checking whether the user is authenticated to query existence of the file
632 #&authenticate_user($gsdl_cgi, $username, $collection);
633
634 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
635 $gsdl_cgi->checked_chdir($collection_directory); # cd into the directory of that collection
636
637 # Check that the collection file exists
638 if (-e $file) {
639 $gsdl_cgi->generate_ok_message("File $file exists.");
640 } else {
641 $gsdl_cgi->generate_ok_message("File $file does not exist.");
642 }
643}
644
645sub download_collection_file
646{
647 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
648
649 my $collection = $gsdl_cgi->clean_param("c");
650 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
651 $gsdl_cgi->generate_error("No collection specified.");
652 }
653 my $file = $gsdl_cgi->clean_param("file");
654 if ((!defined $file) || ($file =~ m/^\s*$/)) {
655 $gsdl_cgi->generate_error("No file specified.");
656 }
657 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
658
659 # Make sure we don't try to download anything outside the collection
660 if ($file =~ m/\.\./) {
661 $gsdl_cgi->generate_error("Illegal file specified.");
662 }
663
664 # Ensure the user is allowed to edit this collection
665 &authenticate_user($gsdl_cgi, $username, $collection, $site);
666
667 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
668 $gsdl_cgi->checked_chdir($collection_directory);
669
670 # Check that the collection file exists
671 if (!-e $file) {
672 $gsdl_cgi->generate_ok_message("Collection file $file does not exist.");
673 die;
674 }
675
676 # Make sure the collection isn't locked by someone else
677 &lock_collection($gsdl_cgi, $username, $collection, $site);
678
679 # Zip up the collection file
680 my $java = $gsdl_cgi->get_java_path();
681 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
682 my $zip_file_path = &util::filename_cat($collection_directory, $collection . "-file-" . $timestamp . ".zip");
683 my $java_args = "\"$zip_file_path\" \"$collection_directory\" \"$file\"";
684 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
685
686 my $java_output = `$java_command`;
687 my $java_status = $?;
688 if ($java_status > 0) {
689 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
690 }
691
692 # Check that the zip file was created successfully
693 if (!-e $zip_file_path || -z $zip_file_path) {
694 $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
695 }
696
697 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
698 unlink("$zip_file_path") unless $debugging_enabled;
699}
700
701# download web.xml from the server
702sub download_web_xml_file
703{
704 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
705
706 # Users can be in any group to perform this action
707 my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site);
708
709 my $file = $gsdl_cgi->clean_param("file");
710 if ((!defined $file) || ($file =~ m/^\s*$/)) {
711 $gsdl_cgi->generate_error("No file specified.");
712 }
713 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
714
715 # Make sure we don't try to download anything else
716 if ($file =~ m/\.\./) {
717 $gsdl_cgi->generate_error("Illegal file specified.");
718 }
719
720 my $web_inf_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "WEB-INF");
721 $gsdl_cgi->checked_chdir($web_inf_directory);
722
723 # Check that the collection file exists
724 if (!-e $file) {
725 $gsdl_cgi->generate_error("file $file does not exist.");
726 }
727
728 # Zip up the collection file
729 my $java = $gsdl_cgi->get_java_path();
730 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
731 my $zip_file_path = &util::filename_cat($web_inf_directory, "webxml" . $timestamp . ".zip");
732 my $java_args = "\"$zip_file_path\" \"$web_inf_directory\" \"$file\"";
733 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
734 my $java_output = `$java_command`;
735
736 my $java_status = $?;
737 if ($java_status > 0) {
738 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
739 }
740
741 # Check that the zip file was created successfully
742 if (!-e $zip_file_path || -z $zip_file_path) {
743 $gsdl_cgi->generate_error("web.xml zip file $zip_file_path could not be created.");
744 }
745
746 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
747
748 unlink("$zip_file_path") unless $debugging_enabled;
749}
750
751# Collection locking unnecessary because this action isn't related to a particular collection
752sub get_script_options
753{
754 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
755
756 my $script = $gsdl_cgi->clean_param("script");
757 if ((!defined $script) || ($script =~ m/^\s*$/)) {
758 $gsdl_cgi->generate_error("No script specified.");
759 }
760 $gsdl_cgi->delete("script");
761
762 # Users can be in any group to perform this action
763 &authenticate_user($gsdl_cgi, $username, "", $site);
764 $gsdl_cgi->delete("ts"); ## two lines from GS3 version, doesn't seem to harm GS2
765 $gsdl_cgi->delete("pw");
766
767
768 my $perl_args = "";
769 if ($script eq "classinfo.pl") {
770 $perl_args = $gsdl_cgi->clean_param("classifier") || "";
771 $gsdl_cgi->delete("classifier");
772 }
773 if ($script eq "pluginfo.pl") {
774 $perl_args = $gsdl_cgi->clean_param("plugin") || "";
775 $gsdl_cgi->delete("plugin");
776 }
777
778 foreach my $cgi_arg_name ($gsdl_cgi->param) {
779 my $cgi_arg_value = $gsdl_cgi->clean_param($cgi_arg_name) || "";
780 $cgi_arg_value = $gsdl_cgi->safe_val($cgi_arg_value);
781 if ($cgi_arg_value eq "") {
782 $perl_args = "-$cgi_arg_name " . $perl_args;
783 }
784 else {
785 $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
786 }
787 }
788
789
790 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
791 # directly out to the page
792 print STDOUT "Content-type:text/plain\n\n";
793 my $perl_command;
794 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2)
795 {
796 $perl_command = "perl -S $script $perl_args";
797 } else {
798 $perl_command = "perl -S $script $perl_args 2>&1";
799 }
800
801 my $perl_output = `$perl_command`;
802 my $perl_status = $?;
803 if ($perl_status > 0) {
804 $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\n$perl_output\nExit status: " . ($perl_status / 256));
805 }
806
807 if (defined($perl_output))
808 {
809 print STDOUT $perl_output;
810 }
811}
812
813# get the names of all sites available on the server
814sub get_site_names
815{
816 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
817 my $sites_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites");
818
819 my @sites_dir;
820 my @site_dir;
821
822 $gsdl_cgi->checked_chdir($sites_directory);
823 opendir(DIR, $sites_directory);
824 @sites_dir= readdir(DIR);
825 my $sites_dir;
826 my $sub_dir_file;
827
828 print STDOUT "Content-type:text/plain\n\n";
829 foreach $sites_dir(@sites_dir)
830 {
831 if (!(($sites_dir eq ".") || ($sites_dir eq "..") || ($sites_dir eq "CVS")))
832 {
833 my $site_dir_path= &util::filename_cat($sites_directory,$sites_dir);
834 $gsdl_cgi->checked_chdir($site_dir_path);
835 opendir(DIR,$site_dir_path);
836 @site_dir=readdir(DIR);
837 closedir(DIR);
838
839 foreach $sub_dir_file(@site_dir)
840 {
841 if ($sub_dir_file eq "siteConfig.xml"){
842 print STDOUT "$sites_dir" . "-----";
843 }
844 }
845 }
846 }
847
848}
849
850sub move_collection_file
851{
852 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
853
854 my $collection = $gsdl_cgi->clean_param("c");
855 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
856 $gsdl_cgi->generate_error("No collection specified.");
857 }
858 my $source_file = $gsdl_cgi->clean_param("source");
859 if ((!defined $source_file) || ($source_file =~ m/^\s*$/)) {
860 $gsdl_cgi->generate_error("No source file specified.");
861 }
862 $source_file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
863 my $target_file = $gsdl_cgi->clean_param("target");
864 if ((!defined $target_file) || ($target_file =~ m/^\s*$/)) {
865 $gsdl_cgi->generate_error("No target file specified.");
866 }
867 $target_file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
868
869 # Make sure we don't try to move anything outside the collection
870 if ($source_file =~ m/\.\./ || $target_file =~ m/\.\./) {
871 $gsdl_cgi->generate_error("Illegal file specified.");
872 }
873
874 # Ensure the user is allowed to edit this collection
875 &authenticate_user($gsdl_cgi, $username, $collection, $site);
876
877 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
878 $gsdl_cgi->checked_chdir($collection_directory);
879
880 # Check that the collection source file exists
881 if (!-e $source_file) {
882 $gsdl_cgi->generate_error("Collection file $source_file does not exist.");
883 }
884
885 # Make sure the collection isn't locked by someone else
886 &lock_collection($gsdl_cgi, $username, $collection, $site);
887
888 &util::mv($source_file, $target_file);
889
890 # Check that the collection source file was moved
891 if (-e $source_file || !-e $target_file) {
892 $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file."); # dies
893 }
894
895 $gsdl_cgi->generate_ok_message("Collection file $source_file moved to $target_file successfully.");
896}
897
898
899sub new_collection_directory
900{
901 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
902
903 my $collection = $gsdl_cgi->clean_param("c");
904 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
905 $gsdl_cgi->generate_error("No collection specified.");
906 }
907 my $directory = $gsdl_cgi->clean_param("directory");
908 if ((!defined $directory) || ($directory =~ m/^\s*$/)) {
909 $gsdl_cgi->generate_error("No directory specified.");
910 }
911 $directory =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
912
913 # Make sure we don't try to create anything outside the collection
914 if ($directory =~ m/\.\./) {
915 $gsdl_cgi->generate_error("Illegal directory specified.");
916 }
917
918 # Ensure the user is allowed to edit this collection
919 &authenticate_user($gsdl_cgi, $username, $collection, $site);
920
921 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
922 $gsdl_cgi->checked_chdir($collection_directory);
923
924 # Check that the collection directory doesn't already exist
925 # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicitly
926 # try to create the import directory
927## log -r13497 for GS2's gliserver.pl, Katherine Don explains:
928# "commented out checking for existence of a directory in new_collection_directory
929# as it throws an error which we don't want"
930 #if($gsdl_cgi->greenstone_version() != 2 && -d $directory) {
931 #$gsdl_cgi->generate_error("Collection directory $directory already exists.");
932 #}
933
934 # Make sure the collection isn't locked by someone else
935 &lock_collection($gsdl_cgi, $username, $collection, $site);
936
937 &util::mk_dir($directory);
938
939 # Check that the collection directory was created
940 if (!-d $directory) {
941 $gsdl_cgi->generate_error("Could not create collection directory $directory.");
942 }
943
944 $gsdl_cgi->generate_ok_message("Collection directory $directory created successfully.");
945}
946
947
948sub run_script
949{
950 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
951
952 my $script = $gsdl_cgi->clean_param("script");
953 if ((!defined $script) || ($script =~ m/^\s*$/)) {
954 $gsdl_cgi->generate_error("No script specified.");
955 }
956 $gsdl_cgi->delete("script");
957
958 my $collection = $gsdl_cgi->clean_param("c");
959 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
960 $gsdl_cgi->generate_error("No collection specified.");
961 }
962 $gsdl_cgi->delete("c");
963
964 # confuse other, so delete timestamp
965 $gsdl_cgi->delete("ts");
966
967 # Ensure the user is allowed to edit this collection
968 &authenticate_user($gsdl_cgi, $username, $collection, $site);
969
970 # Make sure the collection isn't locked by someone else (unless we're running mkcol.pl, of course)
971 &lock_collection($gsdl_cgi, $username, $collection, $site) unless ($script eq "mkcol.pl");
972
973 # Last argument is the collection name, except for explode_metadata_database.pl and
974 # replace_srcdoc_with_html (where there's a "file" option followed by the filename. These two preceed the collection name)
975 my $perl_args = $collection;
976 if ($script eq "explode_metadata_database.pl" || $script eq "replace_srcdoc_with_html.pl") {
977 # Last argument is the file to be exploded or it is the file to be replaced with its html version
978 my $file = $gsdl_cgi->clean_param("file");
979 if ((!defined $file) || ($file =~ m/^\s*$/)) {
980 $gsdl_cgi->generate_error("No file specified.");
981 }
982 $gsdl_cgi->delete("file");
983 #$file =~ s/ /\\ /g; # Works on linux: escape all spaces in filename with a backslash, i.e. "\ ".
984 $file = "\"$file\""; # Windows: bookend the relative filepath with quotes in case it contains spaces
985 $perl_args = $file;
986 }
987
988 foreach my $cgi_arg_name ($gsdl_cgi->param) {
989 my $cgi_arg_value = $gsdl_cgi->safe_val($gsdl_cgi->clean_param($cgi_arg_name));
990 if ($cgi_arg_value eq "") {
991 $perl_args = "-$cgi_arg_name " . $perl_args;
992 }
993 else {
994 $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
995 }
996 }
997
998 # mkcol.pl and import.pl, buildcol.pl, g2f-import.pl, g2f-buildcol.pl all need the -collectdir option passed
999 my $import_pl = "import.pl"; # import is a reserved word, need to put it in quotes
1000
1001 if (($script =~ m/$import_pl|buildcol.pl/) || ($script eq "mkcol.pl")) { # || ($script eq "schedule.pl")
1002 my $collect_directory = $gsdl_cgi->get_collection_dir($site);
1003 $perl_args = $perl_args . " -collectdir \"$collect_directory\"";
1004 }
1005
1006 my $perl_command = "perl -S $script $perl_args 2>&1";
1007 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
1008 # directly out to the page
1009 if($gsdl_cgi->greenstone_version() == 2 && $iis6_mode)
1010 {
1011 $perl_command = "perl -S $script $perl_args";
1012 }
1013 if (!open(PIN, "$perl_command |")) {
1014 $gsdl_cgi->generate_error("Unable to execute command: $perl_command");
1015 }
1016
1017 print STDOUT "Content-type:text/plain\n\n";
1018 print "$perl_command \n";
1019
1020 while (defined (my $perl_output_line = <PIN>)) {
1021 print STDOUT $perl_output_line;
1022 }
1023 close(PIN);
1024
1025 my $perl_status = $?;
1026 if ($perl_status > 0) {
1027 $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\nExit status: " . ($perl_status / 256));
1028 }
1029 elsif ($mail_enabled) {
1030 if ($script eq "buildcol.pl") {
1031 &send_mail($gsdl_cgi, "Remote Greenstone building event", "Build of collection '$collection' complete.");
1032 }
1033 }
1034}
1035
1036sub upload_collection_file
1037{
1038 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
1039
1040 my $collection = $gsdl_cgi->clean_param("c");
1041 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
1042 $gsdl_cgi->generate_error("No collection specified.");
1043 }
1044 my $file = $gsdl_cgi->clean_param("file");
1045 if ((!defined $file) || ($file =~ m/^\s*$/)) {
1046 $gsdl_cgi->generate_error("No file specified.");
1047 }
1048 my $directory = $gsdl_cgi->clean_param("directory") || "";
1049 $directory =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
1050 my $zip = $gsdl_cgi->clean_param("zip");
1051
1052 # Make sure we don't try to upload anything outside the collection
1053 if ($file =~ m/\.\./) {
1054 $gsdl_cgi->generate_error("Illegal file specified.");
1055 }
1056 if ($directory =~ m/\.\./) {
1057 $gsdl_cgi->generate_error("Illegal directory specified.");
1058 }
1059
1060 # Ensure the user is allowed to edit this collection
1061 if($gsdl_cgi->greenstone_version() == 2) { ## Quan commented this out for GS3 in r14325
1062 &authenticate_user($gsdl_cgi, $username, $collection, $site); # site will be undefined for GS2, of course
1063 }
1064
1065 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
1066 $gsdl_cgi->checked_chdir($collection_directory);
1067
1068 # Make sure the collection isn't locked by someone else
1069 &lock_collection($gsdl_cgi, $username, $collection, $site);
1070
1071 my $directory_path = &util::filename_cat($collection_directory, $directory);
1072 if (!-d $directory_path) {
1073 &util::mk_dir($directory_path);
1074 if (!-d $directory_path) {
1075 $gsdl_cgi->generate_error("Could not create directory $directory_path.");
1076 }
1077 }
1078
1079 #my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
1080 my $file_path = "";
1081 if($gsdl_cgi->greenstone_version() == 2) {
1082 $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
1083 } else {
1084 $file_path = &util::filename_cat($directory_path, $file);
1085 }
1086
1087 if (!open(FOUT, ">$file_path")) {
1088 print STDERR "Unable to write file $file_path\n";
1089 $gsdl_cgi->generate_error("Unable to write file $file_path");
1090 }
1091
1092 # Read the uploaded data and write it out to file
1093 my $buf;
1094 my $num_bytes = 0;
1095 binmode(FOUT);
1096 if($gsdl_cgi->greenstone_version() == 2) { ##
1097 # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be
1098 # completely incapable of working this out otherwise (causing the old code to crash)
1099 my $num_bytes_remaining = $gsdl_cgi->clean_param("fs");
1100 my $bytes_to_read = $num_bytes_remaining;
1101 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }
1102
1103 while (read(STDIN, $buf, $bytes_to_read) > 0) {
1104 print FOUT $buf;
1105 $num_bytes += length($buf);
1106 $num_bytes_remaining -= length($buf);
1107 $bytes_to_read = $num_bytes_remaining;
1108 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }
1109 }
1110 } else { # GS3 and later
1111 my $bread;
1112 my $fh = $gsdl_cgi->clean_param("uploaded_file");
1113
1114 if (!defined $fh) {
1115 print STDERR "ERROR. Filehandle undefined. No file uploaded onto GS3 server.\n";
1116 $gsdl_cgi->generate_error("ERROR. Filehandle undefined. No file uploaded (GS3 server).");
1117 } else {
1118 while ($bread=read($fh, $buf, 1024)) {
1119 print FOUT $buf;
1120 }
1121 }
1122 }
1123 close(FOUT);
1124
1125 # If we have downloaded a zip file, unzip it
1126 if (defined $zip) {
1127 my $java = $gsdl_cgi->get_java_path();
1128 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
1129 my $java_args = "\"$file_path\" \"$directory_path\"";
1130 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";
1131
1132 my $java_output = `$java_command`;
1133 my $java_status = $?;
1134
1135 # Remove the zip file once we have unzipped it, since it is an intermediate file only
1136 unlink("$file_path") unless $debugging_enabled;
1137
1138 if ($java_status > 0) {
1139 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); # dies
1140 }
1141 }
1142
1143 $gsdl_cgi->generate_ok_message("Collection file $file uploaded successfully.");
1144}
1145
1146sub put_file
1147{
1148 my $gsdl_cgi = shift(@_);
1149 my $file_path = shift(@_);
1150 my $content_type = shift(@_);
1151
1152 if(!defined $content_type) { ##
1153 $content_type = "application/zip";
1154 }
1155
1156 if (open(PIN, "<$file_path")) {
1157 print STDOUT "Content-type:$content_type\n\n"; ## For GS3: "Content-type:application/zip\n\n";
1158 my $buf;
1159 my $num_bytes = 0;
1160 binmode(PIN);
1161 while (read(PIN, $buf, 1024) > 0) {
1162 print STDOUT $buf;
1163 $num_bytes += length($buf);
1164 }
1165
1166 close(PIN);
1167 }
1168 else {
1169 $gsdl_cgi->generate_error("Unable to read file $file_path\n $!");
1170 }
1171}
1172
1173
1174sub send_mail
1175{
1176 my $gsdl_cgi = shift(@_);
1177 my $mail_subject = shift(@_);
1178 my $mail_content = shift(@_);
1179
1180 my $sendmail_command = "perl -S sendmail.pl";
1181 $sendmail_command .= " -to \"" . $mail_to_address . "\"";
1182 $sendmail_command .= " -from \"" . $mail_from_address . "\"";
1183 $sendmail_command .= " -smtp \"" . $mail_smtp_server . "\"";
1184 $sendmail_command .= " -subject \"" . $mail_subject . "\"";
1185
1186 if (!open(POUT, "| $sendmail_command")) {
1187 $gsdl_cgi->generate_error("Unable to execute command: $sendmail_command");
1188 }
1189 print POUT $mail_content . "\n";
1190 close(POUT);
1191}
1192
1193sub greenstone_server_version
1194{
1195 my $gsdl_cgi = shift(@_);
1196 my $version = $gsdl_cgi->greenstone_version();
1197 $gsdl_cgi->generate_ok_message("Greenstone server version is: $version\n");
1198}
1199
1200sub get_library_url_suffix
1201{
1202 my $gsdl_cgi = shift(@_);
1203 my $library_url = $gsdl_cgi->library_url_suffix();
1204 $gsdl_cgi->generate_ok_message("Greenstone library URL suffix is: $library_url\n");
1205}
1206
1207&main();
Note: See TracBrowser for help on using the repository browser.