modules/Command.pm

   1 package Command;
   2
   3 #
   4 # Dev-Editor - Module Command
   5 #
   6 # Execute Dev-Editor's commands
   7 #
   8 # Author:        Patrick Canterino <patshaping@gmx.net>
   9 # Last modified: 2003-10-20
  10 #
  11
  12 use strict;
  13
  14 use vars qw(@EXPORT
  15             $script);
  16
  17 use CGI qw(redirect);
  18
  19 use File::Access;
  20 use File::Copy;
  21
  22 use HTML::Entities;
  23 use Output;
  24 use POSIX qw(strftime);
  25 use Tool;
  26
  27 $script = $ENV{'SCRIPT_NAME'};
  28
  29 ### Export ###
  30
  31 use base qw(Exporter);
  32
  33 @EXPORT = qw(exec_show
  34              exec_beginedit
  35              exec_endedit
  36              exec_mkfile
  37              exec_mkdir
  38              exec_workwithfile
  39              exec_copy
  40              exec_rename
  41              exec_remove
  42              exec_unlock);
  43
  44 # exec_show()
  45 #
  46 # View a directory or a file
  47 #
  48 # Params: 1. Reference to user input hash
  49 #         2. Reference to config hash
  50 #
  51 # Return: Output of the command (Scalar Reference)
  52
  53 sub exec_show($$$)
  54 {
  55  my ($data,$config) = @_;
  56  my $physical       = $data->{'physical'};
  57  my $virtual        = $data->{'virtual'};
  58  my $output;
  59
  60  if(-d $physical)
  61  {
  62   # Create directory listing
  63
  64   my $direntries = dir_read($physical);
  65   return error("Reading of directory $virtual failed") unless($direntries);
  66
  67   my $files = $direntries->{'files'};
  68   my $dirs  = $direntries->{'dirs'};
  69
  70   $output .= htmlhead("Directory listing of $virtual");
  71   $output .= equal_url($config->{'httproot'},$virtual);
  72   $output .= "<hr>\n\n<pre>\n";
  73
  74   # Create the link to the upper directory
  75   # (only if we are not in the root directory)
  76
  77   unless($virtual eq "/")
  78   {
  79    my $upper = $physical."/..";
  80    my @stat  = stat($upper);
  81
  82    $output .= "  [SUBDIR]  ";
  83    $output .= strftime("%d.%m.%Y %H:%M",localtime($stat[9]));
  84    $output .= " " x 10;
  85    $output .= "<a href=\"$script?command=show&file=".encode_entities(upper_path($virtual))."\">../</a>\n";
  86   }
  87
  88   # Get the length of the longest file/directory name
  89
  90   my $max_name_len = 0;
  91
  92   foreach(@$dirs,@$files)
  93   {
  94    my $length    = length($_);
  95    $max_name_len = $length if($length > $max_name_len);
  96   }
  97
  98   # Directories
  99
 100   foreach my $dir(@$dirs)
 101   {
 102    my @stat = stat($physical."/".$dir);
 103
 104    $output .= "  ";
 105    $output .= "[SUBDIR]  ";
 106    $output .= strftime($config->{'timeformat'},localtime($stat[9]));
 107    $output .= " " x 10;
 108    $output .= "<a href=\"$script?command=show&file=".encode_entities($virtual.$dir)."/\">".encode_entities($dir)."/</a>\n";
 109   }
 110
 111   # Files
 112
 113   foreach my $file(@$files)
 114   {
 115    my $phys_path = $physical."/".$file;
 116    my $virt_path = encode_entities($virtual.$file);
 117
 118    my @stat      = stat($phys_path);
 119    my $in_use    = $data->{'uselist'}->in_use($virtual.$file);
 120
 121    $output .= " " x (10 - length($stat[7]));
 122    $output .= $stat[7];
 123    $output .= "  ";
 124    $output .= strftime($config->{'timeformat'},localtime($stat[9]));
 125    $output .= ($in_use) ? " (IN USE) " : (not -T $phys_path) ? " (BINARY) " : " " x 10;
 126    $output .= encode_entities($file);
 127    $output .= " " x ($max_name_len - length($file))."\t  (";
 128
 129    $output .= (-r $phys_path && -T $phys_path)
 130               ? "<a href=\"$script?command=show&file=$virt_path\">View</a>"
 131               : '<span style="color:#C0C0C0">View</span>';
 132
 133    $output .= " | ";
 134
 135    $output .= (-w $phys_path && -r $phys_path && -T $phys_path && not $in_use)
 136               ? "<a href=\"$script?command=beginedit&file=$virt_path\">Edit</a>"
 137               : '<span style="color:#C0C0C0">Edit</span>';
 138
 139    $output .= " | <a href=\"$script?command=workwithfile&file=$virt_path\">Do other stuff</a>)\n";
 140   }
 141
 142   $output .= "</pre>\n\n<hr>\n\n";
 143
 144   # Bottom of directory listing
 145   # (Fields for creating files and directories)
 146
 147   $output .= <<END;
 148 <table border="0">
 149 <tr>
 150 <form action="$script">
 151 <input type="hidden" name="command" value="mkdir">
 152 <input type="hidden" name="curdir" value="$virtual">
 153 <td>Create new directory:</td>
 154 <td>$virtual <input type="text" name="newfile"> <input type="submit" value="Create!"></td>
 155 </form>
 156 </tr>
 157 <tr>
 158 <td>Create new file:</td>
 159 <form action="$script">
 160 <input type="hidden" name="command" value="mkfile">
 161 <input type="hidden" name="curdir" value="$virtual">
 162 <td>$virtual <input type="text" name="newfile"> <input type="submit" value="Create!"></td>
 163 </form>
 164 </tr>
 165 </table>
 166
 167 <hr>
 168 END
 169   $output .= htmlfoot;
 170  }
 171  else
 172  {
 173   # View a file
 174
 175   return error("You have not enough permissions to view this file.") unless(-r $physical);
 176
 177   # Check on binary files
 178   # We have to do it in this way, or empty files
 179   # will be recognized as binary files
 180
 181   unless(-T $physical)
 182   {
 183    # Binary file
 184
 185    return error("This editor is not able to view/edit binary files.");
 186   }
 187   else
 188   {
 189    # Text file
 190
 191    $output  = htmlhead("Contents of file ".encode_entities($virtual));
 192    $output .= equal_url($config->{'httproot'},$virtual);
 193    $output .= dir_link($virtual);
 194
 195    $output .= '<div style="background-color:#FFFFE0;border:1px solid black;margin-top:10px;width:100%">'."\n";
 196    $output .= '<pre style="color:#0000C0;">'."\n";
 197    $output .= encode_entities(${file_read($physical)});
 198    $output .= "\n</pre>\n</div>";
 199
 200    $output .= htmlfoot;
 201   }
 202  }
 203
 204  return \$output;
 205 }
 206
 207 # exec_beginedit
 208 #
 209 # Lock a file and display a form to edit it
 210 #
 211 # Params: 1. Reference to user input hash
 212 #         2. Reference to config hash
 213 #
 214 # Return: Output of the command (Scalar Reference)
 215
 216 sub exec_beginedit($$)
 217 {
 218  my ($data,$config) = @_;
 219  my $physical       = $data->{'physical'};
 220  my $virtual        = $data->{'virtual'};
 221  my $uselist        = $data->{'uselist'};
 222
 223  return error("You cannot edit directories.") if(-d $physical);
 224  return error_in_use($virtual) if($uselist->in_use($virtual));
 225  return error("You have not enough permissions to edit this file.") unless(-r $physical && -w $physical);
 226
 227  # Check on binary files
 228
 229  unless(-T $physical)
 230  {
 231   # Binary file
 232
 233   return error("This editor is not able to view/edit binary files.");
 234  }
 235  else
 236  {
 237   # Text file
 238
 239   $uselist->add_file($virtual);
 240   $uselist->save;
 241
 242   my $dir       = upper_path($virtual);
 243   my $content   = encode_entities(${file_read($physical)});
 244
 245   my $equal_url = equal_url($config->{'httproot'},$virtual);
 246
 247   $virtual   = encode_entities($virtual);
 248
 249   my $output = htmlhead("Edit file $virtual");
 250   $output   .= $equal_url;
 251   $output   .= <<END;
 252 <p><b style="color:#FF0000">Caution!</b> This file is locked for other users while you are editing it. To unlock it, click <i>Save and exit</i> or <i>Exit WITHOUT saving</i>. Please <b>don't</b> click the <i>Reload</i> button in your browser! This will confuse the editor.</p>
 253
 254 <form action="$script" method="get">
 255 <input type="hidden" name="command" value="canceledit">
 256 <input type="hidden" name="file" value="$virtual">
 257 <p><input type="submit" value="Exit WITHOUT saving"></p>
 258 </form>
 259
 260 <form action="$script" method="post">
 261 <input type="hidden" name="command" value="endedit">
 262 <input type="hidden" name="file" value="$virtual">
 263
 264 <table width="100%" border="1">
 265 <tr>
 266 <td width="50%" align="center">
 267 <input type="hidden" name="file" value="$virtual">
 268 <input type="checkbox" name="saveas" value="1"> Save as new file: $dir <input type=text name="newfile" value=""></td>
 269 <td width="50%" align="center"><input type="checkbox" name="encode_iso" value="1"> Encode ISO-8859-1 special chars</td>
 270 </tr>
 271 <tr>
 272 <td align="center"><input type="reset" value="Reset form"></td>
 273 <td align="center"><input type="submit" value="Save and exit"></td>
 274 </tr>
 275 </table>
 276
 277 <textarea name="filecontent" rows="25" cols="120">$content</textarea>
 278 </form>
 279 END
 280
 281   $output .= htmlfoot;
 282
 283   return \$output;
 284  }
 285 }
 286
 287 # exec_endedit()
 288 #
 289 # Save a file, unlock it and return to directory view
 290 #
 291 # Params: 1. Reference to user input hash
 292 #         2. Reference to config hash
 293 #
 294 # Return: Output of the command (Scalar Reference)
 295
 296 sub exec_endedit($$)
 297 {
 298  my ($data,$config) = @_;
 299  my $physical       = $data->{'physical'};
 300  my $virtual        = $data->{'virtual'};
 301  my $content        = $data->{'cgi'}->param('filecontent');
 302
 303  return error("You cannot edit directories.") if(-d $physical);
 304  return error("You have not enough permissions to edit this file.") unless(-r $physical && -w $physical);
 305
 306  # Normalize newlines
 307
 308  $content =~ s/\015\012|\012|\015/\n/g;
 309
 310  if($data->{'cgi'}->param('encode_iso'))
 311  {
 312   # Encode all ISO-8859-1 special chars
 313
 314   $content = encode_entities($content,"\200-\377");
 315  }
 316
 317  if($data->{'cgi'}->param('saveas'))
 318  {
 319   # Create the new filename
 320
 321   $physical = $data->{'new_physical'};
 322   $virtual  = $data->{'new_virtual'};
 323  }
 324
 325  if(file_save($physical,\$content))
 326  {
 327   # Saving of the file was successful - so unlock it!
 328
 329   return exec_unlock($data,$config);
 330  }
 331  else
 332  {
 333   return error("Saving of file '".encode_entities($virtual)."' failed'.",upper_path($virtual));
 334  }
 335 }
 336
 337 # exec_mkfile()
 338 #
 339 # Create a file and return to directory view
 340 #
 341 # Params: 1. Reference to user input hash
 342 #         2. Reference to config hash
 343 #
 344 # Return: Output of the command (Scalar Reference)
 345
 346 sub exec_mkfile($$)
 347 {
 348  my ($data,$config) = @_;
 349  my $new_physical   = $data->{'new_physical'};
 350  my $new_virtual    = $data->{'new_virtual'};
 351  my $dir            = upper_path($new_virtual);
 352  $new_virtual       = encode_entities($new_virtual);
 353
 354  return error("A file or directory called '$new_virtual' already exists.",$dir) if(-e $new_physical);
 355
 356  file_create($new_physical) or return error("Could not create file '$new_virtual'.",$dir);
 357
 358  my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=$dir");
 359  return \$output;
 360 }
 361
 362 # exec_mkdir()
 363 #
 364 # Create a directory and return to directory view
 365 #
 366 # Params: 1. Reference to user input hash
 367 #         2. Reference to config hash
 368 #
 369 # Return: Output of the command (Scalar Reference)
 370
 371 sub exec_mkdir($$)
 372 {
 373  my ($data,$config) = @_;
 374  my $new_physical   = $data->{'new_physical'};
 375  my $new_virtual    = $data->{'new_virtual'};
 376  my $dir            = upper_path($new_virtual);
 377  $new_virtual       = encode_entities($new_virtual);
 378
 379  return error("A file or directory called '$new_virtual' already exists.",$dir) if(-e $new_physical);
 380
 381  mkdir($new_physical) or return error("Could not create directory '$new_virtual'.",$dir);
 382
 383  my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=$dir");
 384  return \$output;
 385 }
 386
 387 # exec_workwithfile()
 388 #
 389 # Display a form for renaming/copying/deleting/unlocking a file
 390 #
 391 # Params: 1. Reference to user input hash
 392 #         2. Reference to config hash
 393 #
 394 # Return: Output of the command (Scalar Reference)
 395
 396 sub exec_workwithfile($$)
 397 {
 398  my ($data,$config) = @_;
 399  my $physical       = $data->{'physical'};
 400  my $virtual        = $data->{'virtual'};
 401  my $unused         = $data->{'uselist'}->unused($virtual);
 402
 403  my $dir = encode_entities(upper_path($virtual));
 404
 405  my $output = htmlhead("Work with file ".encode_entities($virtual));
 406  $output   .= equal_url($config->{'httproot'},$virtual);
 407
 408  $virtual   = encode_entities($virtual);
 409
 410  $output   .= dir_link($virtual);
 411  $output   .= "<p><b>Note:</b> On UNIX systems, filenames are <b>case-sensitive</b>!</p>\n\n";
 412
 413  $output .= "<p>Someone else is currently editing this file. So not all features are available.</p>\n\n" unless($unused);
 414
 415  # Copying of the file as always allowed
 416
 417  $output .= <<END;
 418 <hr>
 419
 420 <h2>Copy</h2>
 421
 422 <form action="$script">
 423 <input type="hidden" name="command" value="copy">
 424 <input type="hidden" name="file" value="$virtual">
 425 <p>Copy file '$virtual' to: $dir <input type="text" name="newfile" size="50"> <input type="submit" value="Copy!"></p>
 426 </form>
 427
 428 <hr>
 429
 430 END
 431
 432  if($unused)
 433  {
 434   # File is not locked
 435   # Allow renaming and deleting the file
 436
 437   $output .= <<END;
 438 <h2>Move/rename</h2>
 439
 440 <form action="$script">
 441 <input type="hidden" name="command" value="rename">
 442 <input type="hidden" name="file" value="$virtual">
 443 <p>Move/Rename file '$virtual' to: $dir <input type="text" name="newfile" size="50"> <input type="submit" value="Move/Rename!"></p>
 444 </form>
 445
 446 <hr>
 447
 448 <h2>Delete</h2>
 449
 450 <form action="$script" method="get">
 451 <input type="hidden" name="file" value="$virtual">
 452 <input type="hidden" name="command" value="remove">
 453 <p><input type="submit" value="Delete file '$virtual'!"></p>
 454 </form>
 455 END
 456  }
 457  else
 458  {
 459   # File is locked
 460   # Just display a button for unlocking it
 461
 462   $output .= <<END;
 463 <h2>Unlock file</h2>
 464
 465 <p>Someone else is currently editing this file. At least, the file is marked so. Maybe, someone who was editing the file has forgotten to unlock it. In this case (and <b>only</b> in this case) you can unlock the file using this button:</p>
 466
 467 <form action="$script" method="get">
 468 <input type="hidden" name="file" value="$virtual">
 469 <input type="hidden" name="command" value="unlock">
 470 <p><input type="submit" value="Unlock file '$virtual'"></p>
 471 </form>
 472 END
 473  }
 474
 475  $output .= "\n<hr>";
 476  $output .= htmlfoot;
 477
 478  return \$output;
 479 }
 480
 481 # exec_copy()
 482 #
 483 # Copy a file and return to directory view
 484 #
 485 # Params: 1. Reference to user input hash
 486 #         2. Reference to config hash
 487 #
 488 # Return: Output of the command (Scalar Reference)
 489
 490 sub exec_copy($$)
 491 {
 492  my ($data,$config) = @_;
 493  my $physical       = $data->{'physical'};
 494  my $virtual        = encode_entities($data->{'virtual'});
 495  my $new_physical   = $data->{'new_physical'};
 496  my $new_virtual    = $data->{'new_virtual'};
 497  my $dir            = upper_path($new_virtual);
 498  $new_virtual       = encode_entities($new_virtual);
 499
 500  return error("This editor is not able to copy directories.") if(-d $physical);
 501
 502  if(-e $new_physical)
 503  {
 504   return error("A file or directory called '$new_virtual' already exists and this editor is currently not able to ask to overwrite the existing file or directory.",upper_path($virtual));
 505  }
 506
 507  copy($physical,$new_physical) or return error("Could not copy '$virtual' to '$new_virtual'",upper_path($virtual));
 508
 509  my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=$dir");
 510  return \$output;
 511 }
 512
 513 # exec_rename()
 514 #
 515 # Rename/move a file and return to directory view
 516 #
 517 # Params: 1. Reference to user input hash
 518 #         2. Reference to config hash
 519 #
 520 # Return: Output of the command (Scalar Reference)
 521
 522 sub exec_rename($$)
 523 {
 524  my ($data,$config) = @_;
 525  my $physical       = $data->{'physical'};
 526  my $virtual        = $data->{'virtual'};
 527  my $new_physical   = $data->{'new_physical'};
 528  my $new_virtual    = $data->{'new_virtual'};
 529  my $dir            = upper_path($new_virtual);
 530  $new_virtual       = encode_entities($new_virtual);
 531
 532  return error_in_use($virtual) if($data->{'uselist'}->in_use($virtual));
 533
 534  if(-e $new_physical)
 535  {
 536   return error("A file or directory called '$new_virtual' already exists and this editor is currently not able to ask to overwrite the existing file or directory.",upper_path($virtual));
 537  }
 538
 539  rename($physical,$new_physical) or return error("Could not move/rename '".encode_entities($virtual)."' to '$new_virtual'.",upper_path($virtual));
 540
 541  my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=$dir");
 542  return \$output;
 543 }
 544
 545 # exec_remove()
 546 #
 547 # Remove a file and return to directory view
 548 #
 549 # Params: 1. Reference to user input hash
 550 #         2. Reference to config hash
 551 #
 552 # Return: Output of the command (Scalar Reference)
 553
 554 sub exec_remove($$)
 555 {
 556  my ($data,$config) = @_;
 557  my $physical       = $data->{'physical'};
 558  my $virtual        = $data->{'virtual'};
 559
 560  return error("Deleting directories is currently unsupported.") if(-d $physical);
 561  return error_in_use($virtual) if($data->{'uselist'}->in_use($virtual));
 562
 563  unlink($physical) or return error("Could not delete file '".encode_entities($virtual)."'.",upper_path($virtual));
 564
 565  my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=".upper_path($virtual));
 566  return \$output;
 567 }
 568
 569 # exec_unlock()
 570 #
 571 # Remove a file from the list of used files and
 572 # return to directory view
 573 #
 574 # Params: 1. Reference to user input hash
 575 #         2. Reference to config hash
 576 #
 577 # Return: Output of the command (Scalar Reference)
 578
 579 sub exec_unlock($$)
 580 {
 581  my ($data,$config) = @_;
 582  my $virtual        = $data->{'virtual'};
 583  my $uselist        = $data->{'uselist'};
 584
 585  $uselist->remove_file($virtual);
 586  $uselist->save;
 587
 588  my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=".upper_path($virtual));
 589  return \$output;
 590 }
 591
 592 # it's true, baby ;-)
 593
 594 1;
 595
 596 #
 597 ### End ###