]>
git.ipfire.org Git - people/mfischer/ipfire-2.x.git/blob - html/cgi-bin/extrahd.cgi
2 ###############################################################################
4 # IPFire.org - A linux based firewall #
5 # Copyright (C) 2023 IPFire Team <info@ipfire.org> #
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. #
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. #
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/>. #
20 ###############################################################################
23 # enable only the following on debugging purpose
25 #use CGI::Carp 'fatalsToBrowser';
27 require '/var/ipfire/general-functions.pl' ;
28 require "${General::swroot}/lang.pl" ;
29 require "${General::swroot}/header.pl" ;
31 my %extrahdsettings = ();
32 my $errormessage = "" ;
34 # Hash to store the configured drives.
35 my %configured_drives ;
37 # SYSFS directory which contains all block device data.
38 my $sysfs_block_dir = "/sys/class/block" ;
40 # Array which contains the valid mount directories.
41 # Only mounting to subdirectories inside them is allowed.
42 my @valid_mount_dirs = (
48 # Grab all available block devices.
49 my @devices = & get_block_devices
();
51 # Grab all known UUID's.
52 my %uuids = & get_uuids
();
54 # Detect device mapper devices.
55 my %device_mapper = & get_device_mapper
();
57 # Grab members of group devices (RAID, LVM)
58 my %grouped_devices = & collect_grouped_devices
();
60 # Grab all mountpoints.
61 my %mountpoints = & get_mountpoints
();
63 # Omit the file system types of the mounted devices.
64 my %filesystems = & get_mountedfs
();
66 # Gather all used swap devices.
67 my @swaps = & get_swaps
();
69 # The config file which contains the configured devices.
70 my $devicefile = "/var/ipfire/extrahd/devices" ;
72 #workaround to suppress a warning when a variable is used only once
73 my @dummy = ( ${ Header
:: colourgreen
}, ${ Header
:: colourred
} );
76 & Header
:: showhttpheaders
();
78 ### Values that have to be initialized
79 $extrahdsettings { 'PATH' } = '' ;
80 $extrahdsettings { 'FS' } = '' ;
81 $extrahdsettings { 'DEVICE' } = '' ;
82 $extrahdsettings { 'ACTION' } = '' ;
83 $extrahdsettings { 'UUID' } = '' ;
85 & Header
:: getcgihash
( \
%extrahdsettings );
87 & Header
:: openpage
( 'ExtraHD' , 1 , '' );
88 & Header
:: openbigbox
( '100%' , 'left' , '' , $errormessage );
90 ############################################################################################################################
91 ############################################################################################################################
96 if ( $extrahdsettings { 'ACTION' } eq $Lang :: tr
{ 'add' }) {
97 # Check if a mount path has been given.
98 if ( not $extrahdsettings { 'PATH' }) {
99 $errormessage = " $Lang ::tr{'extrahd no mount point given'}." ;
101 # Check if a valid mount path has been choosen.
102 } elsif ( not & is_valid_dir
( " $extrahdsettings {'PATH'}" )) {
103 $errormessage = " $Lang ::tr{'extrahd you cant mount'} $extrahdsettings {'DEVICE'} $Lang ::tr{'extrahd to'} $extrahdsettings {'PATH'} $Lang ::tr{'extrahd because it is outside the allowed mount path'}." ;
105 # Check if the given path allready is mounted somewhere.
106 } elsif (& is_mounted
( " $extrahdsettings {'PATH'}" )) {
107 $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'}." ;
110 # Check against may previously configured drives.
111 unless ( $errormessage ) {
112 # Open device file for reading.
113 open ( FILE
, "< $devicefile " ) or die "Unable to read $devicefile " ;
114 my @devices = < FILE
>;
117 # Loop through the entries line-by-line.
118 foreach my $entry ( sort @devices ) {
119 # Split the line into pieces and assign nice variables.
120 my ( $uuid , $fs , $path ) = split ( /\;/ , $entry );
122 # Remove tailing UUID= from uuid string.
123 $uuid =~ s{^UUID=}{} ;
125 # Check if the path is allready used.
126 if ( " $extrahdsettings {'PATH'}" eq " $path " ) {
127 $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'}." ;
130 # Check if the uuid is allready used.
131 if ( " $extrahdsettings {'UUID'}" eq " $uuid " ) {
132 $errormessage = " $extrahdsettings {'DEVICE'} is allready mounted." ;
137 # Go further if there was no error message.
138 unless ( $errormessage ) {
139 # Re-open the device file for writing.
140 open ( FILE
, ">> $devicefile " ) or die "Unable to write $devicefile " ;
142 # Write the config line.
143 print FILE
"UUID= $extrahdsettings {'UUID'}; $extrahdsettings {'FS'}; $extrahdsettings {'PATH'}; \n " ;
148 # Call helper binary to mount the device.
149 & General
:: system ( "/usr/local/bin/extrahdctrl" , "mount" , " $extrahdsettings {'PATH'}" );
153 # Remove an existing one.
155 } elsif ( $extrahdsettings { 'ACTION' } eq $Lang :: tr
{ 'delete' }) {
156 # Call helper binary to unmount the device.
157 unless (& General
:: system ( "/usr/local/bin/extrahdctrl" , "umount" , " $extrahdsettings {'PATH'}" )) {
158 # Open the device file for reading.
159 open ( FILE
, "< $devicefile " ) or die "Unable to read $devicefile " ;
161 # Read the file content into a temporary array.
167 # Re-open device file for writing.
168 open ( FILE
, "> $devicefile " ) or die "Unable to write $devicefile " ;
170 # Loop through the previous read file content.
171 foreach my $line ( sort @tmp ) {
172 # Split line content and assign nice variables.
173 my ( $uuid , $fs , $path ) = split ( /\;/ , $line );
175 # Write the line in case it does not contain our element to delete.
176 if ( $path ne $extrahdsettings { 'PATH' }) {
184 $errormessage = " $Lang ::tr{'extrahd cant umount'} $extrahdsettings {'PATH'} $Lang ::tr{'extrahd maybe the device is in use'}?" ;
189 & Header
:: openbox
( '100%' , 'left' , $Lang :: tr
{ 'error messages' });
190 print "<class name='base'> $errormessage \n " ;
191 print " </class> \n " ;
195 ############################################################################################################################
196 ############################################################################################################################
198 & Header
:: openbox
( '100%' , 'center' , $Lang :: tr
{ 'extrahd detected drives' });
200 # Re-read mountpoints.
201 %mountpoints = & get_mountpoints
();
203 # Read-in the device config file.
204 open ( FILE
, "< $devicefile " ) or die "Unable to read $devicefile " ;
206 # Loop through the file content.
208 # Cut the line into pieces.
209 my ( $uuid , $fs , $path ) = split ( /\;/ , $_ );
211 # Add the found entry to the hash of configured drives.
212 $configured_drives { $uuid } = $path ;
215 # Close the file handle.
219 <table border='0' width='100%' cellspacing="0">
222 foreach my $device ( sort @devices ) {
223 # Grab the device details.
224 my $vendor = & get_device_vendor
( $device );
225 my $model = & get_device_model
( $device );
226 my $bsize = & get_device_size
( $device );
228 # Convert size into human-readable format.
229 my $size = & General
:: formatBytes
( $bsize );
232 <tr><td colspan="5"> </td></tr>
233 <tr><td align='left' colspan="2"><b>/dev/ $device </b></td>
234 <td align='center' colspan="2"> $vendor $model </td>
236 <td align='center'> $Lang ::tr{'size'} $size </td>
238 <tr><td colspan="5"> </td></tr>
242 # Grab the known partitions of the current block device.
243 my @partitions = & get_device_partitions
( $device );
245 # Check if the block device has any partitions for display.
247 # Loop through the partitions.
248 foreach my $partition ( @partitions ) {
249 # Call function to display the row in the WUI.
250 & print_row
( $partition );
254 # Also print rows for devices with an UUID.
255 & print_row
( $device ) if ( $uuids { $device });
259 <tr><td align="center" colspan="5"> </td></tr>
260 <tr><td align="center" colspan="5"> </td></tr>
261 <tr><td align="center" colspan="5"> $Lang ::tr{'extrahd install or load driver'}</td></tr>
268 & Header
:: closebigbox
();
269 & Header
:: closepage
();
273 # Function to print a table row with device data on the WUI.
276 my ( $partition ) = @_ ;
280 # Omit the partition size.
281 my $bsize = & get_device_size
( $partition );
283 # Convert into human-readable format.
284 my $size = & General
:: formatBytes
( $bsize );
286 # Try to omit the used filesystem.
287 my $fs = $filesystems { $partition };
289 # Get the mountpoint.
290 my $mountpoint = $mountpoints { $partition };
292 # Generate partition string.
293 my $partition_string = "/dev/ $partition " ;
295 # Check if the given partition is managed by device mapper.
296 if ( exists ( $device_mapper { $partition })) {
297 # Alter the partition string to used one by the device mapper.
298 $partition_string = " $device_mapper { $partition }" ;
301 # Check if the device is part of a group.
302 my $grouped_device = & is_grouped_member
( $partition );
304 # If no mountpoint could be determined try to grab from
306 unless ( $mountpoint ) {
307 my $uuid = $uuids { $partition };
310 $uuid = "UUID=" . $uuid ;
312 # Try to obtain a possible moutpoint from configured drives.
313 $mountpoint = $configured_drives { $uuid } if ( $configured_drives { $uuid });
316 # Check if the mountpoint is used as root or boot device.
317 if ( $mountpoint eq "/" or $mountpoint =~ "^/boot" ) {
318 $disabled = "disabled" ;
320 # Check if it is mounted.
321 } elsif (& is_mounted
( $mountpoint )) {
322 $disabled = "disabled" ;
324 # Check if the device is used as swap.
325 } elsif (& is_swap
( $partition )) {
326 $disabled = "disabled" ;
327 $mountpoint = "swap" ;
330 # Check if the device is part of a group.
331 } elsif ( $grouped_device ) {
332 $disabled = "disabled" ;
333 $mountpoint = "/dev/ $grouped_device " ;
334 $mountpoint = $device_mapper { $grouped_device } if ( exists ( $device_mapper { $grouped_device }));
337 print "<form method='post' action=' $ENV {'SCRIPT_NAME'}'> \n " ;
339 # Only display UUID details if an UUID could be obtained.
340 if ( $uuids { $partition } ) {
341 print "<tr><td align='left' colspan=5><strong>UUID= $uuids { $partition }</strong></td></tr> \n " ;
347 <td align="list"> $partition_string </td>
348 <td align="center"> $Lang ::tr{'size'} $size </td>
349 <td align="center"> $fs </td>
350 <td align="center"><input type='text' name='PATH' value=' $mountpoint ' $disabled ></td>
352 <input type='hidden' name='DEVICE' value=' $partition_string ' />
353 <input type='hidden' name='UUID' value=' $uuids { $partition }' />
356 # Check if the mountpoint refers to a known configured drive.
357 if (& is_configured
( $mountpoint )) {
358 print "<input type='hidden' name='ACTION' value=' $Lang ::tr{'delete'}'> \n " ;
359 print "<input type='hidden' name='PATH' value=' $mountpoint '> \n " ;
361 # Check if the device is mounted properly.
362 if (& is_mounted
( $mountpoint )) {
363 print "<img src='/images/updbooster/updxl-led-green.gif' alt=' $Lang ::tr{'extrahd mounted'}' title=' $Lang ::tr{'extrahd mounted'}'> \n " ;
365 print "<img src='/images/updbooster/updxl-led-red.gif' alt=' $Lang ::tr{'extrahd not mounted'}' title=' $Lang ::tr{'extrahd not mounted'}'> \n " ;
368 print "<input type='image' alt=' $Lang ::tr{'delete'}' title=' $Lang ::tr{'delete'}' src='/images/delete.gif'> \n " ;
371 print "<input type='hidden' name='ACTION' value=' $Lang ::tr{'add'}'> \n " ;
372 print "<input type='hidden' name='FS' value='auto'> \n " ;
373 print "<img src='/images/updbooster/updxl-led-gray.gif' alt=' $Lang ::tr{'extrahd not configured'}' title=' $Lang ::tr{'extrahd not configured'}'> \n " ;
374 print "<input type='image' alt=' $Lang ::tr{'add'}' title=' $Lang ::tr{'add'}' src='/images/add.gif'> \n " ;
385 ## Function which return an array with all available block devices.
387 sub get_block_devices
() {
390 # Open directory from kernel sysfs.
391 opendir ( DEVICES
, "/sys/block" );
393 # Loop through the directory.
394 while ( readdir ( DEVICES
)) {
396 next if ( $_ =~ /^\.$/ );
397 next if ( $_ =~ /^\..$/ );
399 # Skip any loopback and ram devices.
400 next if ( $_ =~ "^loop" );
401 next if ( $_ =~ "^ram" );
403 # Add the device to the array of found devices.
407 # Close directory handle.
410 # Return the devices array.
415 ## Function which return all partitions of a given block device.
417 sub get_device_partitions
($) {
420 # Array to store the known partitions for the given
424 # Assign device directory.
425 my $device_dir = " $sysfs_block_dir / $device " ;
427 # Abort and return nothing if the device dir does not exist.
428 return unless (- d
" $device_dir " );
430 opendir ( DEVICE
, " $sysfs_block_dir / $device " );
431 while ( readdir ( DEVICE
)) {
432 next unless ( $_ =~ "^ $device " );
434 push ( @partitions , $_ );
439 @partitions = sort ( @partitions );
445 ## Returns the vendor of a given block device.
447 sub get_device_vendor
($) {
450 # Assign device directory.
451 my $device_dir = " $sysfs_block_dir / $device " ;
453 # Abort and return nothing if the device dir does not exist
454 # or no vendor file exists.
455 return unless (- d
" $device_dir " );
456 return unless (- f
" $device_dir /device/vendor" );
458 # Open and read-in the device vendor.
459 open ( VENDOR
, " $device_dir /device/vendor" );
460 my $vendor = < VENDOR
>;
463 # Abort and return nothing if no vendor could be read.
464 return unless ( $vendor );
466 # Remove any newlines from the vendor string.
469 # Return the omited vendor.
474 ## Returns the model name (string) of a given block device.
476 sub get_device_model
($) {
479 # Assign device directory.
480 my $device_dir = " $sysfs_block_dir / $device " ;
482 # Abort and return nothing if the device dir does not exist
483 # or no model file exists.
484 return unless (- d
" $device_dir " );
485 return unless (- f
" $device_dir /device/model" );
487 # Open and read-in the device model.
488 open ( MODEL
, " $device_dir /device/model" );
492 # Abort and return nothing if no model could be read.
493 return unless ( $model );
495 # Remove any newlines from the model string.
498 # Return the model string.
503 ## Returns the size of a given device in bytes.
505 sub get_device_size
($) {
508 # Assign device directory.
509 my $device_dir = " $sysfs_block_dir / $device " ;
511 # Abort and return nothing if the device dir does not exist
512 # or no size file exists.
513 return unless (- d
" $device_dir " );
514 return unless (- f
" $device_dir /size" );
516 # Open and read-in the device size.
517 open ( SIZE
, " $device_dir /size" );
521 # Abort and return nothing if the size could not be read.
522 return unless ( $size );
524 # Remove any newlines for the size string.
527 # The omited size only contains the amount of blocks from the
528 # given device. To convert this into bytes we have to multiply this
529 # value with 512 bytes for each block. This is a static value used by
533 # Return the size in bytes.
538 ## Function which tries to detect if a block device is a device mapper device and returns the alias a
539 ## a hash. Example: "dm-0" -> "/dev/mapper/GROUP-DEVICE"
541 sub get_device_mapper
() {
542 my %mapper_devices = ();
544 # Loop through all known block devices.
545 foreach my $block_device ( @devices ) {
546 # Generate device directory.
547 my $device_dir = " $sysfs_block_dir / $block_device " ;
549 # Skip the device if it is not managed by device mapper
550 # In this case the "bd" is not present.
551 next unless (- e
" $device_dir /dm" );
553 # Grab the group and volume name.
554 open ( NAME
, " $device_dir /dm/name" ) if (- e
" $device_dir /dm/name" );
558 # Skip device if no name could be determined.
561 # Remove any newlines from the name string.
564 # Generate path to the dev node in devfs.
565 my $dev_path = "/dev/mapper/ $name " ;
567 # Store the device and the omited mapper name in the hash.
568 $mapper_devices { $block_device } = $dev_path ;
571 # Return the hash of omited device mapper devices.
572 return %mapper_devices ;
576 ## Function which will collect grouped devices and their members as array in a hash and returns them.
577 ## For example: "sda1" -> "dm-0" in case /dev/sda1 is assigned to a device mapper group.
579 sub collect_grouped_devices
() {
580 my %grouped_devices = ();
582 # Loop through the array of known block devices.
583 foreach my $device ( @devices ) {
584 # Generate device directory.
585 my $device_dir = " $sysfs_block_dir / $device " ;
587 # Skip device if it has no members.
588 # In this case the "slaves" directory does not exist.
589 next unless (- e
" $device_dir /slaves" );
591 # Tempoarary array to store the members of a group.
595 opendir ( MEMBERS
, " $device_dir /slaves" );
596 while ( readdir ( MEMBERS
)) {
600 # Add the found member to the array of members.
606 # Skip the device if no members could be grabbed.
607 next unless ( @members );
609 # Add the array of found members as value to the hash of grouped devices.
610 $grouped_devices { $device } = [ @members ];
613 # Return the hash of found grouped devices and their members.
614 return %grouped_devices ;
618 ## Function which returns all currently mounted devices as a hash.
619 ## example: "sda1" -> "/boot"
621 sub get_mountpoints
() {
624 # Open and read-in the current mounts from the
625 # kernel file system.
626 open ( MOUNT
, "/proc/mounts" );
628 # Loop through the known mounts.
630 # Skip mounts which does not belong to a device.
631 next unless ( $_ =~ "^/dev" );
633 # Cut the line into pieces and assign nice variables.
634 my ( $dev , $mpoint , $fs , $options , $a , $b ) = split ( / / , $_ );
636 # Split the device name.
637 my @tmp = split ( "/" , $dev );
639 # Assign the plain device name to a new variable.
640 # It is the last element of the array.
641 my $device = $tmp [- 1 ];
643 # Add the mountpoint to the hash of mountpoints.
644 $mounts { " $device " } = $mpoint ;
650 # Return the hash of known mountpoints.
657 # Open and read the swaps file.
658 open ( SWAP
, "/proc/swaps" );
660 # Loop though the file content.
662 # Skip lines which does not belong to a device.
663 next unless ( $_ =~ "^/dev" );
665 # Split the line and assign nice variables.
666 my ( $dev , $type , $size , $used , $prio ) = split ( / / , $_ );
668 # Cut the device line into pieces.
669 my @tmp = split ( "/" , $dev );
671 my $device = @tmp [- 1 ];
673 # Add the found swap to the array of swaps.
674 push ( @swaps , $device );
681 @swaps = sort ( @swaps );
688 ## Function with returns the mounted devices and the used filesystems as a hash.
689 ## Example: "sda1" -> "ext4"
691 sub get_mountedfs
() {
694 # Open and read the current mounts from the kernel
696 open ( MOUNT
, "/proc/mounts" );
698 # Loop through the known mounts.
700 # Skip mounts which does not belong to a device.
701 next unless ( $_ =~ "^/dev" );
703 # Split line and assign nice variables.
704 my ( $dev , $mpoint , $fs , $options , $a , $b ) = split ( / / , $_ );
706 # Cut the device line into pieces.
707 my @tmp = split ( "/" , $dev );
709 # Assign the plain device name to a variable
710 # It is the last element of the temporary array.
711 my $device = $tmp [- 1 ];
713 # Convert the filesystem into lower case format.
716 # Add the mounted file system.
717 $mountedfs { $device } = $fs ;
723 # Return the hash with the mounted filesystems.
728 ## Function which returns all known UUID's as a hash.
729 ## Example: "sda1" -> "1234-5678-abcd"
734 # Directory where the uuid mappings can be found.
735 my $uuid_dir = "/dev/disk/by-uuid" ;
737 # Open uuid directory and read-in the current known uuids.
738 opendir ( UUIDS
, " $uuid_dir " );
740 # Loop through the uuids.
741 foreach my $uuid ( readdir ( UUIDS
)) {
743 next if ( $uuid eq "." or $uuid eq ".." );
745 # Skip everything which is not a symbolic link.
746 next unless (- l
" $uuid_dir / $uuid " );
748 # Resolve the target of the symbolic link.
749 my $target = readlink ( " $uuid_dir / $uuid " );
751 # Split the link target into pieces.
752 my @tmp = split ( "/" , $target );
754 # Assign the last element of the array to the dev variable.
755 my $dev = " $tmp [-1]" ;
757 # Add the device and uuid to the hash of uuids.
758 $uuids { $dev } = $uuid ;
761 # Close directory handle.
764 # Return the hash of uuids.
769 ## Returns the device name of a given uuid.
771 sub device_by_uuid
($) {
774 # Reverse the main uuids hash.
775 my %uuids = reverse %uuids ;
777 # Lookup and return the device name.
778 return $uuids { $uuid };
782 ## Returns "True" in case a given path is a known mountpoint.
787 my %mountpoints = reverse %mountpoints ;
789 # Return "True" if the requested mountpoint is known and
791 return 1 if ( $mountpoints { $mpoint });
795 ## Returns "True" if a given mountpoint is a subdirectory of one
796 ## of the directories specified by the valid_mount_dirs array abouve.
798 sub is_valid_dir
($) {
801 # Do not allow "/mnt" or "/media" as mount points.
802 return if ( $mpoint eq "/mnt" );
803 return if ( $mpoint eq "/media" );
805 # Split the given mountpoint into pieces and store them
806 # in a temporay array.
807 my @tmp = split ( "/" , $mpoint );
809 # Exit and return nothing if the temporary array is empty.
812 # Build the root path based on the given mount point.
813 my $root_path = "/" . @tmp [ 1 ];
815 # Check if the root path is valid.
816 return 1 if ( grep /$root_path/ , @valid_mount_dirs );
820 # Returns "True" if a device is used as swap.
825 return 1 if ( grep /$device/ , @swaps );
829 ## Returns "True" if a drive is a configured one.
831 sub is_configured
($) {
834 # Loop through the hash of configured drives.
835 foreach my $uuid ( keys %configured_drives ) {
836 return 1 if ( $configured_drives { $uuid } eq " $path " );
841 ## Retruns the device name of the grouped device,if a given device is a group member.
843 sub is_grouped_member
($) {
846 # Loop through the hash of found grouped devices.
847 foreach my $grouped_device ( keys %grouped_devices ) {
848 # The found members are stored as arrays.
849 my @members = @
{ $grouped_devices { $grouped_device } };
851 # Loop through array of members and check if the given
852 # device is part of it.
853 foreach my $member ( @members ) {
854 return $grouped_device if ( $member eq $device );