source: greenstone3/trunk/web/WEB-INF/cgi/gsdlCGI4gs3.pm@ 14368

Last change on this file since 14368 was 14368, checked in by qq6, 15 years ago

added a rot13() to encrypt the password

  • Property svn:executable set to *
File size: 6.7 KB
Line 
1
2package gsdlCGI4gs3;
3
4use CGI;
5use Cwd;
6
7@ISA = ('CGI');
8
9sub new {
10 my $class = shift @_;
11
12 my $self;
13 if ((defined $ENV{'REQUEST_METHOD'}) && ($ENV{'REQUEST_METHOD'} eq "POST")) {
14 my $line = <STDIN>;
15 if ((defined $line) && ($line ne "") && ($line !~ /upload-collection-file/)) {
16 $self = new CGI($line);
17 }
18 else {
19 $self = new CGI();
20 }
21 }
22 else {
23 $self = new CGI();
24 }
25
26 return bless $self, $class;
27}
28
29
30sub parse_cgi_args
31{
32 my $self = shift @_;
33 my $xml = (defined $self->param("xml")) ? 1 : 0;
34
35 $self->{'xml'} = $xml;
36
37 my @var_names = $self->param;
38 my @arg_list = ();
39 foreach my $n ( @var_names ) {
40 my $arg = "$n=";
41 my $val = $self->param($n);
42 $arg .= $val if (defined $val);
43 push(@arg_list,$arg);
44 }
45
46 $self->{'args'} = join("&",@arg_list);
47}
48
49
50sub clean_param
51{
52 my $self = shift @_;
53 my ($param) = @_;
54
55 my $val = $self->SUPER::param($param);
56 $val =~ s/[\r\n]+$// if (defined $val);
57
58 return $val;
59}
60
61sub safe_val
62{
63 my $self = shift @_;
64 my ($val) = @_;
65
66 # ensure only alpha-numeric plus a few other special chars remain
67
68 $val =~ s/[^[:alnum:]@\.\/\- :_]//g if (defined $val);
69
70 return $val;
71}
72
73
74sub generate_error
75{
76 my $self = shift @_;
77 my ($mess) = @_;
78
79 my $xml = $self->{'xml'};
80
81 my $full_mess;
82 my $args = $self->{'args'};
83
84 if ($xml) {
85 # Make $args XML safe
86 my $args_xml_safe = $args;
87 $args_xml_safe =~ s/&/&amp;/g;
88
89 $full_mess = "<Error>\n";
90 $full_mess .= " $mess\n";
91 $full_mess .= " CGI args were: $args_xml_safe\n";
92 $full_mess .= "</Error>\n";
93 }
94 else {
95 $full_mess = "ERROR: $mess\n ($args)\n";
96 }
97
98 print STDOUT "Content-type:text/plain\n\n";
99 print STDOUT $full_mess;
100
101 die $full_mess;
102}
103
104sub generate_warning
105{
106 my $self = shift @_;
107 my ($mess) = @_;
108
109 my $xml = $self->{'xml'};
110
111 my $full_mess;
112 my $args = $self->{'args'};
113
114 if ($xml) {
115 # Make $args XML safe
116 my $args_xml_safe = $args;
117 $args_xml_safe =~ s/&/&amp;/g;
118
119 $full_mess = "<Warning>\n";
120 $full_mess .= " $mess\n";
121 $full_mess .= " CGI args were: $args_xml_safe\n";
122 $full_mess .= "</Warning>\n";
123 }
124 else {
125 $full_mess = "Warning: $mess ($args)\n";
126 }
127
128 print STDOUT "Content-type:text/plain\n\n";
129 print STDOUT $full_mess;
130
131 print STDERR $full_mess;
132}
133
134
135sub generate_ok_message
136{
137 my $self = shift @_;
138 my ($mess) = @_;
139
140 my $xml = $self->{'xml'};
141
142 my $full_mess;
143
144 if ($xml) {
145 $full_mess = "<Accepted>\n";
146 $full_mess .= " $mess\n";
147 $full_mess .= "</Accepted>\n";
148 }
149 else {
150 $full_mess = "$mess\n";
151 }
152
153 print "<pre>";
154 print STDOUT $full_mess;
155 print "</pre>";
156}
157
158
159
160sub get_config_info {
161 my $self = shift @_;
162 my ($infotype) = @_;
163
164 my $site_filename = "gsdl3site.cfg";
165 open (FILEIN, "<$site_filename")
166 || $self->generate_error("Could not open gsdl3site.cfg");
167
168 my $config_content = "";
169 while(defined (my $line = <FILEIN>)) {
170 $config_content .= $line;
171 }
172 close(FILEIN);
173
174 my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m);
175 $loc =~ s/\"//g;
176
177 if ((!defined $loc) || ($loc =~ m/^\s*$/)) {
178 $self->generate_error("$infotype is not set in gsdl3site.cfg");
179 }
180
181 return $loc;
182}
183
184sub get_gsdl3_src_home{
185 my $self = shift @_;
186 if (defined $self->{'gsdl3srchome'}) {
187 return $self->{'gsdl3srchome'};
188 }
189
190 my $gsdl3srchome = $self->get_config_info("gsdl3srchome");
191
192 $gsdl3srchome =~ s/(\/|\\)$//; # remove trailing slash
193
194 $self->{'gsdl3srchome'} = $gsdl3srchome;
195
196 return $gsdl3srchome;
197}
198
199
200sub get_gsdl_home {
201 my $self = shift @_;
202
203 if (defined $self->{'gsdlhome'}) {
204 return $self->{'gsdlhome'};
205 }
206
207 my $gsdlhome = $self->get_config_info("gsdlhome");
208
209 #require "$gsdlhome/perllib/util.pm";
210
211 $gsdlhome =~ s/(\/|\\)$//; # remove trailing slash
212
213 $self->{'gsdlhome'} = $gsdlhome;
214
215 return $gsdlhome;
216}
217
218sub get_gsdl_os {
219 my $self = shift @_;
220
221 my $os = $^O;
222
223 if ($os =~ m/linux/i) {
224 return "linux";
225 }
226 elsif ($os =~ /mswin/i) {
227 return "windows";
228 }
229 elsif ($os =~ /macos/i) {
230 return "darwin";
231 }
232 else {
233 # return as is.
234 return $os;
235 }
236}
237
238sub setup_gsdl {
239 my $self = shift @_;
240
241 my $gsdl3srchome = $self->get_gsdl3_src_home();
242 my $gsdlhome = $self->get_gsdl_home();
243 my $gsdlos = $self->get_gsdl_os();
244
245 $ENV{'GSDL3SRCHOME'} = $gsdl3srchome;
246 $ENV{'GSDLHOME'} = $gsdlhome;
247 $ENV{'GSDLOS'} = $gsdlos;
248 require "$gsdlhome/perllib/util.pm";
249
250 my $gsdl_bin_script = &util::filename_cat($gsdlhome,"bin","script");
251 &util::envvar_append("PATH",$gsdl_bin_script);
252
253 my $gsdl_bin_os = &util::filename_cat($gsdlhome,"bin",$gsdlos);
254 &util::envvar_append("PATH",$gsdl_bin_os);
255
256 if ($gsdlos eq "windows") {
257 my $gsdl_perl_bin_directory = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin");
258 &util::envvar_append("PATH", $gsdl_perl_bin_directory);
259 }
260}
261
262
263sub local_rm_r
264{
265 my $self = shift @_;
266 my ($local_dir) = @_;
267
268 my $prefix_dir = getcwd();
269
270 if ($prefix_dir !~ m/collect/) {
271 $self->generate_error("Trying to delete outside of Greenstone collect: $full_dir");
272 }
273
274 my $full_dir = &util::filename_cat($prefix_dir,$local_dir);
275
276 # Delete recursively
277 if (!-e $full_dir) {
278 $self->generate_error("File/Directory does not exist: $full_dir");
279 }
280
281 &util::rm_r($full_dir);
282}
283
284
285sub get_java_path()
286{
287 # Check the JAVA_HOME environment variable first
288 if (defined $ENV{'JAVA_HOME'}) {
289 my $java_home = $ENV{'JAVA_HOME'};
290 $java_home =~ s/\/$//; # Remove trailing slash if present (Unix specific)
291 return &util::filename_cat($java_home, "bin", "java");
292 }
293
294 # Hope that Java is on the PATH
295 return "java";
296}
297
298
299sub check_java_home()
300{
301 # Return a warning unless the JAVA_HOME enrivonmen variable is set
302 if (!defined $ENV{'JAVA_HOME'}) {
303 return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")";
304 }
305
306 return "";
307}
308
309
310sub checked_chdir
311{
312 my $self = shift @_;
313 my ($dir) = @_;
314
315 if (!-e $dir) {
316 $self->generate_error("Directory '$dir' does not exist");
317 }
318
319 chdir $dir
320 || $self->generate_error("Unable to change to directory: $dir");
321}
322
323sub rot13()
324{
325 my $self = shift @_;
326 my ($password)=@_;
327 my @password_arr=split(//,$password);
328
329 my @encrypt_password;
330 foreach my $str (@password_arr){
331 my $char=unpack("c",$str);
332 if ($char>=97 && $char<=109){
333 $char+=13;
334 }elsif ($char>=110 && $char<=122){
335 $char-=13;
336 }elsif ($char>=65 && $char<=77){
337 $char+=13;
338 }elsif ($char>=78 && $char<=90){
339 $char-=13;
340 }
341 $char=pack("c",$char);
342 push(@encrypt_password,$char);
343 }
344 return join("",@encrypt_password);
345}
346
3471;
348
Note: See TracBrowser for help on using the repository browser.