html/cgi-bin/extrahd.cgi

   1 #!/usr/bin/perl
   2 ###############################################################################
   3 #                                                                             #
   4 # IPFire.org - A linux based firewall                                         #
   5 # Copyright (C) 2011  IPFire Team  <info@ipfire.org>                          #
   6 #                                                                             #
   7 # This program is free software: you can redistribute it and/or modify        #
   8 # it under the terms of the GNU General Public License as published by        #
   9 # the Free Software Foundation, either version 3 of the License, or           #
  10 # (at your option) any later version.                                         #
  11 #                                                                             #
  12 # This program is distributed in the hope that it will be useful,             #
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of              #
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               #
  15 # GNU General Public License for more details.                                #
  16 #                                                                             #
  17 # You should have received a copy of the GNU General Public License           #
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.       #
  19 #                                                                             #
  20 ###############################################################################
  21
  22 use strict;
  23 # enable only the following on debugging purpose
  24 #use warnings;
  25 #use CGI::Carp 'fatalsToBrowser';
  26
  27 require '/var/ipfire/general-functions.pl';
  28 require "${General::swroot}/lang.pl";
  29 require "${General::swroot}/header.pl";
  30
  31 my %extrahdsettings = ();
  32 my $message = "";
  33 my $errormessage = "";
  34 my $size = "";
  35 my $ok = "true";
  36 my @tmp = ();
  37 my @tmpline = ();
  38 my $tmpentry = "";
  39 my @devices = ();
  40 my @deviceline = ();
  41 my $deviceentry = "";
  42 my @scans = ();
  43 my @scanline = ();
  44 my $scanentry = "";
  45 my @partitions = ();
  46 my @partitionline = ();
  47 my $partitionentry = "";
  48 my $devicefile = "/var/ipfire/extrahd/devices";
  49 my $scanfile = "/var/ipfire/extrahd/scan";
  50 my $partitionsfile = "/var/ipfire/extrahd/partitions";
  51
  52 #workaround to suppress a warning when a variable is used only once
  53 my @dummy = ( ${Header::colourgreen}, ${Header::colourred} );
  54 undef (@dummy);
  55
  56 &General::system("/usr/local/bin/extrahdctrl", "scanhd", "ide");
  57 &General::system("/usr/local/bin/extrahdctrl", "scanhd", "partitions");
  58
  59 &Header::showhttpheaders();
  60
  61 ### Values that have to be initialized
  62 $extrahdsettings{'PATH'} = '';
  63 $extrahdsettings{'FS'} = '';
  64 $extrahdsettings{'DEVICE'} = '';
  65 $extrahdsettings{'ACTION'} = '';
  66 $extrahdsettings{'UUID'} = '';
  67
  68 &General::readhash("${General::swroot}/extrahd/settings", \%extrahdsettings);
  69 &Header::getcgihash(\%extrahdsettings);
  70
  71 &Header::openpage('ExtraHD', 1, '');
  72 &Header::openbigbox('100%', 'left', '', $errormessage);
  73
  74 ############################################################################################################################
  75 ############################################################################################################################
  76
  77 if ($extrahdsettings{'ACTION'} eq $Lang::tr{'add'})
  78 {
  79         open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
  80         @devices = <FILE>;
  81         close FILE;
  82         foreach $deviceentry (sort @devices)
  83         {
  84                 @deviceline = split( /\;/, $deviceentry );
  85                 if ( "$extrahdsettings{'PATH'}" eq "$deviceline[2]" ) {
  86                         $ok = "false";
  87                         $errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd because there is already a device mounted'}.";
  88                 }
  89                 if ( "$extrahdsettings{'PATH'}" eq "/" ) {
  90                         $ok = "false";
  91                         $errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to root'}.";
  92                 }
  93         }
  94
  95         if ( "$ok" eq "true" ) {
  96                 open(FILE, ">> $devicefile" ) or die "Unable to write $devicefile";
  97                 print FILE <<END
  98 UUID=$extrahdsettings{'UUID'};$extrahdsettings{'FS'};$extrahdsettings{'PATH'};
  99 END
 100 ;
 101         &General::system("/usr/local/bin/extrahdctrl", "mount", "$extrahdsettings{'PATH'}");
 102         }
 103 }
 104 elsif ($extrahdsettings{'ACTION'} eq $Lang::tr{'delete'})
 105 {
 106         if ( ! &General::system("/usr/local/bin/extrahdctrl", "umount", "$extrahdsettings{'PATH'}")) {
 107                 open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
 108                 @tmp = <FILE>;
 109                 close FILE;
 110                 open( FILE, "> $devicefile" ) or die "Unable to write $devicefile";
 111                 foreach $deviceentry (sort @tmp)
 112                 {
 113                         @tmpline = split( /\;/, $deviceentry );
 114                         if ( $tmpline[2] ne $extrahdsettings{'PATH'} )
 115                         {
 116                                 print FILE $deviceentry;
 117                         }
 118                 }
 119                 close FILE;
 120         } else {
 121                 $errormessage = "$Lang::tr{'extrahd cant umount'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd maybe the device is in use'}?";
 122         }
 123 }
 124
 125 if ($errormessage) {
 126         &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
 127         print "<class name='base'>$errormessage\n";
 128         print "&nbsp;</class>\n";
 129         &Header::closebox();
 130 }
 131
 132 ############################################################################################################################
 133 ############################################################################################################################
 134
 135         open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
 136         @devices = <FILE>;
 137         close FILE;
 138         print <<END
 139                 <table border='0' width='600' cellspacing="0">
 140 END
 141 ;
 142         foreach $deviceentry (sort @devices)
 143         {
 144                 @deviceline = split( /\;/, $deviceentry );
 145                 my $color="$Header::colourred";
 146
 147                 # Use safe system_output to get mountpoint details.
 148                 my @mountpoint = &General::system_output("/bin/mountpoint", "$deviceline[2]");
 149
 150                 if ( ! grep(/not/, @mountpoint)) {
 151                         $color=$Header::colourgreen;
 152                 }
 153                 print <<END
 154                         <tr><td colspan="4">&nbsp;</td></tr>
 155                         <tr><td align='left'><font color=$color><b>$deviceline[0]</b></font></td>
 156                                 <td align='left'>$deviceline[1]</td>
 157                                 <td align='left'>$deviceline[2]</td>
 158                                 <td align='center'>
 159                                         <form method='post' action='$ENV{'SCRIPT_NAME'}'>
 160                                                 <input type='hidden' name='DEVICE' value='$deviceline[0]' />
 161                                                 <input type='hidden' name='FS' value='$deviceline[1]' />
 162                                                 <input type='hidden' name='PATH' value='$deviceline[2]' />
 163                                                 <input type='hidden' name='ACTION' value='$Lang::tr{'delete'}' />
 164                                                 <input type='image' alt='$Lang::tr{'delete'}' title='$Lang::tr{'delete'}' src='/images/delete.gif' />
 165                                         </form></td></tr>
 166 END
 167 ;
 168         }
 169         print <<END
 170                 </table>
 171 END
 172 ;
 173 &Header::openbox('100%', 'center', $Lang::tr{'extrahd detected drives'});
 174         print <<END
 175                 <table border='0' width='600' cellspacing="0">
 176 END
 177 ;
 178         open( FILE, "< $scanfile" ) or die "Unable to read $scanfile";
 179         @scans = <FILE>;
 180         close FILE;
 181         open( FILE, "< $partitionsfile" ) or die "Unable to read $partitionsfile";
 182         @partitions = <FILE>;
 183         close FILE;
 184         foreach $scanentry (sort @scans)
 185         {
 186                 @scanline = split( /\;/, $scanentry );
 187                 # remove wrong entries like usb controller name
 188                 if ($scanline[1] ne "\n")
 189                 {
 190                         print <<END
 191                                 <tr><td colspan="5">&nbsp;</td></tr>
 192                                 <tr><td align='left' colspan="2"><b>/dev/$scanline[0]</b></td>
 193                                 <td align='center' colspan="2">$scanline[1]</td>
 194 END
 195 ;
 196
 197                 }
 198                 foreach $partitionentry (sort @partitions)
 199                 {
 200                         @partitionline = split( /\;/, $partitionentry );
 201                         if ( "$partitionline[0]" eq "$scanline[0]" ) {
 202                                 $size = int($partitionline[1] / 1024);
 203                                 print <<END
 204                                 <td align='center'>$Lang::tr{'size'} $size MB</td>
 205                                 <td>&nbsp;</td></tr>
 206                                 <tr><td colspan="5">&nbsp;</td></tr>
 207 END
 208 ;
 209                         }
 210                 }
 211
 212                 foreach $partitionentry (sort @partitions)
 213                 {
 214                         @partitionline = split( /\;/, $partitionentry );
 215                         if (( "$partitionline[0]" =~ /^$scanline[0]/ ) && !( "$partitionline[2]" eq "" )) {
 216                                 $size = int($partitionline[1] / 1024);
 217                                 print <<END
 218                                 <form method='post' action='$ENV{'SCRIPT_NAME'}'>
 219                                 <tr><td align="left" colspan=5><strong>UUID=$partitionline[2]</strong></td></tr>
 220                                 <tr>
 221                                 <td align="list">/dev/$partitionline[0]</td>
 222                                 <td align="center">$Lang::tr{'size'} $size MB</td>
 223                                 <td align="center"><select name="FS">
 224                                                                                 <option value="auto">auto</option>
 225                                                                                 <option value="ext3">ext3</option>
 226                                                                                 <option value="ext4">ext4</option>
 227                                                                                 <option value="reiserfs">reiserfs</option>
 228                                                                                 <option value="vfat">fat</option>
 229                                                                                 <option value="ntfs-3g">ntfs (experimental)</option>
 230                                                                            </select></td>
 231                                 <td align="center"><input type='text' name='PATH' value=/mnt/harddisk /></td>
 232                                 <td align="center">
 233                                         <input type='hidden' name='DEVICE' value='$partitionline[0]' />
 234                                         <input type='hidden' name='UUID' value='$partitionline[2]' />
 235                                         <input type='hidden' name='ACTION' value='$Lang::tr{'add'}' />
 236                                         <input type='image' alt='$Lang::tr{'add'}' title='$Lang::tr{'add'}' src='/images/add.gif' />
 237                                 </form></td></tr>
 238 END
 239 ;
 240
 241 END
 242 ;
 243                         }
 244                 }
 245         }
 246
 247         print <<END
 248         <tr><td align="center" colspan="5">&nbsp;</td></tr>
 249         <tr><td align="center" colspan="5">&nbsp;</td></tr>
 250         <tr><td align="center" colspan="5">$Lang::tr{'extrahd install or load driver'}</td></tr>
 251         </table>
 252 END
 253 ;
 254 &Header::closebox();
 255
 256 &Header::closebigbox();
 257 &Header::closepage();
 258
 259 #
 260 ## Function which return an array with all available block devices.
 261 #
 262 sub get_block_devices () {
 263         my @devices;
 264
 265         # Open directory from kernel sysfs.
 266         opendir(DEVICES, "/sys/block");
 267
 268         # Loop through the directory.
 269         while(readdir(DEVICES)) {
 270                 # Skip . and ..
 271                 next if($_ =~ /^\.$/);
 272                 next if($_ =~ /^\..$/);
 273
 274                 # Skip any loopback and ram devices.
 275                 next if($_ =~ "^loop");
 276                 next if($_ =~ "^ram");
 277
 278                 # Add the device to the array of found devices.
 279                 push(@devices, $_);
 280         }
 281
 282         # Close directory handle.
 283         closedir(DEVICES);
 284
 285         # Return the devices array.
 286         return @devices;
 287 }
 288
 289 #
 290 ## Function which return all partitions of a given block device.
 291 #
 292 sub get_device_partitions ($) {
 293         my ($device) = @_;
 294
 295         # Array to store the known partitions for the given
 296         # device.
 297         my @partitions;
 298
 299         # Assign device directory.
 300         my $device_dir = "$sysfs_block_dir/$device";
 301
 302         # Abort and return nothing if the device dir does not exist.
 303         return unless(-d "$device_dir");
 304
 305         opendir(DEVICE, "$sysfs_block_dir/$device");
 306         while(readdir(DEVICE)) {
 307                 next unless($_ =~ "^$device");
 308
 309                 push(@partitions, $_);
 310         }
 311
 312         closedir(DEVICE);
 313
 314         @partitions = sort(@partitions);
 315
 316         return @partitions;
 317 }
 318
 319 #
 320 ## Returns the vendor of a given block device.
 321 #
 322 sub get_device_vendor ($) {
 323         my ($device) = @_;
 324
 325         # Assign device directory.
 326         my $device_dir = "$sysfs_block_dir/$device";
 327
 328         # Abort and return nothing if the device dir does not exist
 329         # or no vendor file exists.
 330         return unless(-d "$device_dir");
 331         return unless(-f "$device_dir/device/vendor");
 332
 333         # Open and read-in the device vendor.
 334         open(VENDOR, "$device_dir/device/vendor");
 335         my $vendor = <VENDOR>;
 336         close(VENDOR);
 337
 338         # Abort and return nothing if no vendor could be read.
 339         return unless($vendor);
 340
 341         # Remove any newlines from the vendor string.
 342         chomp($vendor);
 343
 344         # Return the omited vendor.
 345         return $vendor;
 346 }
 347
 348 #
 349 ## Returns the model name (string) of a given block device.
 350 #
 351 sub get_device_model ($) {
 352         my ($device) = @_;
 353
 354         # Assign device directory.
 355         my $device_dir = "$sysfs_block_dir/$device";
 356
 357         # Abort and return nothing if the device dir does not exist
 358         # or no model file exists.
 359         return unless(-d "$device_dir");
 360         return unless(-f "$device_dir/device/model");
 361
 362         # Open and read-in the device model.
 363         open(MODEL, "$device_dir/device/model");
 364         my $model = <MODEL>;
 365         close(MODEL);
 366
 367         # Abort and return nothing if no model could be read.
 368         return unless($model);
 369
 370         # Remove any newlines from the model string.
 371         chomp($model);
 372
 373         # Return the model string.
 374         return $model;
 375 }
 376
 377 #
 378 ## Returns the size of a given device in bytes.
 379 #
 380 sub get_device_size ($) {
 381         my ($device) = @_;
 382
 383         # Assign device directory.
 384         my $device_dir = "$sysfs_block_dir/$device";
 385
 386         # Abort and return nothing if the device dir does not exist
 387         # or no size file exists.
 388         return unless(-d "$device_dir");
 389         return unless(-f "$device_dir/size");
 390
 391         # Open and read-in the device size.
 392         open(SIZE, "$device_dir/size");
 393         my $size = <SIZE>;
 394         close(SIZE);
 395
 396         # Abort and return nothing if the size could not be read.
 397         return unless($size);
 398
 399         # Remove any newlines for the size string.
 400         chomp($size);
 401
 402         # The omited size only contains the amount of blocks from the
 403         # given device. To convert this into bytes we have to multiply this
 404         # value with 512 bytes for each block. This is a static value used by
 405         # the linux kernel.
 406         $size = $size * 512;
 407
 408         # Return the size in bytes.
 409         return $size;
 410 }
 411
 412 #
 413 ## Function which returns all currently mounted devices as a hash.
 414 ## example: "sda1" -> "/boot"
 415 #
 416 sub get_mountpoints () {
 417         my %mounts;
 418
 419         # Open and read-in the current mounts from the
 420         # kernel file system.
 421         open(MOUNT, "/proc/mounts");
 422
 423         # Loop through the known mounts.
 424         while(<MOUNT>) {
 425                 # Skip mounts which does not belong to a device.
 426                 next unless ($_ =~ "^/dev");
 427
 428                 # Cut the line into pieces and assign nice variables.
 429                 my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
 430
 431                 # Split the device name.
 432                 my @tmp = split("/", $dev);
 433
 434                 # Assign the plain device name to a new variable.
 435                 # It is the last element of the array.
 436                 my $device = $tmp[-1];
 437
 438                 # Add the mountpoint to the hash of mountpoints.
 439                 $mounts{"$device"} = $mpoint;
 440         }
 441
 442         # Close file handle.
 443         close(MOUNT);
 444
 445         # Return the hash of known mountpoints.
 446         return %mounts;
 447 }
 448
 449 sub get_swaps () {
 450         my @swaps;
 451
 452         # Open and read the swaps file.
 453         open(SWAP, "/proc/swaps");
 454
 455         # Loop though the file content.
 456         while(<SWAP>) {
 457                 # Skip lines which does not belong to a device.
 458                 next unless ($_ =~ "^/dev");
 459
 460                 # Split the line and assign nice variables.
 461                 my ($dev, $type, $size, $used, $prio) = split(/ /, $_);
 462
 463                 # Cut the device line into pieces.
 464                 my @tmp = split("/", $dev);
 465
 466                 my $device = @tmp[-1];
 467
 468                 # Add the found swap to the array of swaps.
 469                 push(@swaps, $device);
 470         }
 471
 472         # Close file handle.
 473         close(SWAP);
 474
 475         # Sort the array.
 476         @swaps = sort(@swaps);
 477
 478         # Return the array.
 479         return @swaps;
 480 }
 481
 482 #
 483 ## Function with returns the mounted devices and the used filesystems as a hash.
 484 ## Example: "sda1" -> "ext4"
 485 #
 486 sub get_mountedfs () {
 487         my %mountedfs;
 488
 489         # Open and read the current mounts from the kernel
 490         # file system.
 491         open(MOUNT, "/proc/mounts");
 492
 493         # Loop through the known mounts.
 494         while(<MOUNT>) {
 495                 # Skip mounts which does not belong to a device.
 496                 next unless ($_ =~ "^/dev");
 497
 498                 # Split line and assign nice variables.
 499                 my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
 500
 501                 # Cut the device line into pieces.
 502                 my @tmp = split("/", $dev);
 503
 504                 # Assign the plain device name to a variable
 505                 # It is the last element of the temporary array.
 506                 my $device = $tmp[-1];
 507
 508                 # Convert the filesystem into lower case format.
 509                 $fs = lc($fs);
 510
 511                 # Add the mounted file system.
 512                 $mountedfs{$device} = $fs;
 513         }
 514
 515         # Close file handle.
 516         close(MOUNT);
 517
 518         # Return the hash with the mounted filesystems.
 519         return %mountedfs;
 520 }
 521
 522 #
 523 ## Function which returns all known UUID's as a hash.
 524 ## Example: "sda1" -> "1234-5678-abcd"
 525 #
 526 sub get_uuids () {
 527         my %uuids;
 528
 529         # Directory where the uuid mappings can be found.
 530         my $uuid_dir = "/dev/disk/by-uuid";
 531
 532         # Open uuid directory and read-in the current known uuids.
 533         opendir(UUIDS, "$uuid_dir");
 534
 535         # Loop through the uuids.
 536         foreach my $uuid (readdir(UUIDS)) {
 537                 # Skip . and ..
 538                 next if($uuid eq "." or $uuid eq "..");
 539
 540                 # Skip everything which is not a symbolic link.
 541                 next unless(-l "$uuid_dir/$uuid");
 542
 543                 # Resolve the target of the symbolic link.
 544                 my $target = readlink("$uuid_dir/$uuid");
 545
 546                 # Split the link target into pieces.
 547                 my @tmp = split("/", $target);
 548
 549                 # Assign the last element of the array to the dev variable.
 550                 my $dev = "$tmp[-1]";
 551
 552                 # Add the device and uuid to the hash of uuids.
 553                 $uuids{$dev} = $uuid;
 554         }
 555
 556         # Close directory handle.
 557         closedir(UUIDS);
 558
 559         # Return the hash of uuids.
 560         return %uuids;
 561 }
 562
 563 #
 564 ## Returns the device name of a given uuid.
 565 #
 566 sub device_by_uuid ($) {
 567         my ($uuid) = @_;
 568
 569         # Reverse the main uuids hash.
 570         my %uuids = reverse %uuids;
 571
 572         # Lookup and return the device name.
 573         return $uuids{$uuid};
 574 }
 575
 576 #
 577 ## Returns "True" in case a given path is a known mountpoint.
 578 #
 579 sub is_mounted ($) {
 580         my ($mpoint) = @_;
 581
 582         my %mountpoints = reverse %mountpoints;
 583
 584         # Return "True" if the requested mountpoint is known and
 585         # therefore mounted.
 586         return 1 if($mountpoints{$mpoint});
 587 }
 588
 589 #
 590 ## Returns "True" if a given mountpoint is a subdirectory of one
 591 ## of the directories specified by the valid_mount_dirs array abouve.
 592 #
 593 sub is_valid_dir ($) {
 594         my ($mpoint) = @_;
 595
 596         # Split the given mountpoint into pieces and store them
 597         # in a temporay array.
 598         my @tmp = split("/", $mpoint);
 599
 600         # Exit and return nothing if the temporary array is empty.
 601         return unless(@tmp);
 602
 603         # Build the root path based on the given mount point.
 604         my $root_path = "/" . @tmp[1];
 605
 606         # Check if the root path is valid.
 607         return 1 if(grep /$root_path/, @valid_mount_dirs);
 608 }
 609
 610 #
 611 # Returns "True" if a device is used as swap.
 612 #
 613 sub is_swap ($) {
 614         my ($device) = @_;
 615
 616         return 1 if(grep /$device/, @swaps);
 617 }