#!/usr/bin/perl

=encoding utf8
=head1 NAME

pisk - Curses application allowing an unprivileged user to manage disks and partitions

=head1 VERSION

This documentation refers to pisk version 0.1.2.

=head1 USAGE

The application ignore any argument, just call it from a terminal:

  pisk

=head1 AUTHOR

Timothée Floure (<timothee.floure@fnux.ch>)

=head1 LICENSE AND COPYRIGHT

Pisk - Curses application allowing an unprivileged user to manage disks
Copyright (C) 2018  Timothée Flooure

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut

### Ignore some Perl::Critic rules:
## no critic (ProhibitAccessOfPrivateData)
## no critic (ProhibitHashBarewords)
## no critic (ProhibitNumberedNames)
## no critic (RequireExtendedFormatting)

use utf8;
use strict;
use warnings;
use feature "switch";

use Curses::UI;
use Net::DBus;
use Carp;

### Disks

sub index_block_devices_by_drive {
	my ($block_devices) = @_;

	my %drive_tree = ();
	@{ $block_devices } = sort {
		get_block_device_path($a) cmp get_block_device_path($b)
	} @{ $block_devices };
	foreach my $block_device (@{ $block_devices }) {
		push @{ $drive_tree{$block_device->Drive} }, $block_device }

	return \%drive_tree;
}

sub refresh_listbox_content {
	my ($udisks2, $values, $labels) = @_;

	# Empty the 'values' array first to remove old entries
	splice(@{ $values });
	# FIXME: do the same with the labels

	# Fetch and process the list of block devices
	my $block_devices = get_block_device_list($udisks2);
	my $drive_tree = index_block_devices_by_drive($block_devices);

	foreach my $drive_path (sort keys %{ $drive_tree }) {
		# FIXME: find an elegant way to check the drive exists
		if ($drive_path ne '/') {
			my $drive = $udisks2->get_object($drive_path);
			my $label = sprintf("%-30s\n", $drive->Vendor . $drive->Model);

			push @{ $values }, $drive;
			$labels->{$drive} = $label;
		} else {
			push @{ $values }, $drive_path;
			$labels->{$drive_path} = 'Unknown drive';
		}

		foreach my $block_device (@{ $drive_tree->{$drive_path} }) {
			my $label = sprintf('  %-15s', get_block_device_path($block_device));

			given ($block_device) {
				when (implements_udisks2_interface($_, 'Filesystem')) {
					$label .= $block_device->IdType;

					if (list_filesystem_mountpoints($block_device)) {
						$label .= ' - ' . list_filesystem_mountpoints($block_device);
					}

					my $filesystem = $block_device->as_interface(
						'org.freedesktop.UDisks2.Filesystem'
					);
					my $humanized_size = $filesystem->Size / (2 ** 30);
					$label .= ' - ' . $humanized_size . ' GB';
				}
				when (implements_udisks2_interface($_, 'Swapspace')) {
					$label .= 'Swap space';
				}
				when (implements_udisks2_interface($_, 'Encrypted')) {
					$label .= 'Encrypted';
				}
				when (implements_udisks2_interface($_, 'Partition')) {
					my $partition = $block_device->as_interface(
						'org.freedesktop.UDisks2.Partition'
					);
					my $humanized_size = $partition->Size / (2 ** 30);
					$label .= ' - ' . $humanized_size . ' GB';
				}
			}

			push @{ $values }, $block_device;
			$labels->{$block_device} = $label;
		}
	}

	return;
}

sub get_block_device_list {
	my ($udisks2) = @_;

	# Get and list knwown block devices
	my $manager = $udisks2->get_object(
		'/org/freedesktop/UDisks2/Manager',
		'org.freedesktop.UDisks2.Manager'
	);
	my $paths = $manager->GetBlockDevices({'auth.no_user_interaction' => 0});

	my @block_devices = ();
	foreach my $path (@{ $paths }) {
		my $block_device = $udisks2->get_object($path);
		dbus_introspect($block_device);
		push @block_devices, $block_device;
	}

	return \@block_devices;
}

sub implements_udisks2_interface {
	my ($dbus_object, $name) = @_;

	if (ref $dbus_object ne 'Net::DBus::RemoteObject') {
		return 0;
	}

	my $interface = 'org.freedesktop.UDisks2.' . $name;
	return $dbus_object->{introspector}->has_interface($interface);
}

sub get_block_device_path {
	my ($block_device) = @_;

	my $char_codes = $block_device->Device;
	my @chars = map { chr($_) } @{ $char_codes };

	# The last item of the array returned by the Device methods is the NULL
	# character
	pop @chars;

	return join('', @chars);
}

sub list_filesystem_mountpoints {
	my ($filesystem) = @_;
	unless (implements_udisks2_interface($filesystem, 'Filesystem')) {
		return;
	}

	my $raw_list = $filesystem->MountPoints;
	my @mountpoints = ();
	foreach my $raw_chars (@{ $raw_list }) {
		my @chars = map { chr($_) } @{ $raw_chars };

		# The last item of the array returned by the Device methods is the NULL
		# character
		pop @chars;

		push @mountpoints, join('', @chars);
	}

	return join(',', @mountpoints);
}

sub dbus_introspect {
	my ($dbus_object) = @_;

	# FIXME: this method is supposed to be private
	return $dbus_object->_net_dbus_introspector();
}

sub mount_filesystem {
	my ($device) = @_;

	my $filesystem = $device->as_interface('org.freedesktop.UDisks2.Filesystem');
	my $mountpoint = $filesystem->Mount({});

	return $mountpoint;
}

sub unmount_filesystem {
	my ($device) = @_;

	my $filesystem = $device->as_interface('org.freedesktop.UDisks2.Filesystem');
	$filesystem->Unmount({});

	return;
}

sub active_swapspace {
	my ($device) = @_;

	my $swapspace = $device->as_interface('org.freedesktop.UDisks2.Swapspace');
	$swapspace->Start({});

	return;
}

sub disable_swapspace {
	my ($device) = @_;

	my $swapspace = $device->as_interface('org.freedesktop.UDisks2.Swapspace');
	$swapspace->Stop({});

	return;
}

### UI

sub define_curses_windows {
	my ($cui) = @_;

	my $main = $cui->add(
		'main', 'Window',
		-title        => 'Pisk',
		-border       => 1,
		-titlereverse => 0,
		-padtop       => 0,
		-padbottom    => 3,
		-ipad         => 1,
	);

	my $footer = $cui->add(
		'foot', 'Window',
		-border        => 1,
		-y             => -1,
		-height        => 3,
	);

	my $windows = { main => $main, footer => $footer };
	return $windows;
}

sub define_curses_listbox {
	my ($cui, $window, $udisks2, $values, $labels) = @_;

	my $listbox = $window->add(
		undef, 'Listbox',
		-values => $values,
		-labels => $labels,
		-htmltext => 1,
		-y => 6
	);

	$listbox->focus();
	$listbox->onChange(
		sub {
			handle_listbox_event($cui, $udisks2, $listbox, $values, $labels);
		}
	);

	return $listbox;
}

sub populate_curses_windows {
	my ($win) = @_;

	$win->{main}->add(undef, 'Label',
		-text => 'Manage disks, partitions and filesystems as an unpriviledged' .
		' user.'
	);

	my $list_header = 'Available devices';
	$win->{main}->add(undef, 'Label',
		-text => $list_header,
		-y => 4,
		-bold =>1
	);

	$win->{footer}->add(undef, 'Label',
		-text => 'q: quit   r: refresh    h/j/k/l or arrows: move   enter: select'
	);

	return;
}

sub define_curses_bindings {
	my ($udisks2, $cui, $listbox, $listbox_values, $listbox_labels) = @_;

	$cui->set_binding(
		sub { $cui->mainloopExit() }, "q"
	);
	$cui->set_binding(
		sub {
			refresh_listbox_content($udisks2, $listbox_values, $listbox_labels);
			$listbox->draw();
		},
		"r"
	);

	return;
}

### Main logic

sub handle_udisks2_action {
	my ($cui, $action, $device) = @_;

	my $action_result = eval { $action->(); };
	if ( $@ ) { $cui->error($@); }

	return;
}

sub handle_listbox_event {
	my ($cui, $udisks2, $listbox, $listbox_values, $listbox_labels) = @_;

	my $device = $listbox->get();
	my $dialog_title = q{}; #Violates ProhibitCallsToUndeclaredSubs
	my $dialog_content = q{}; #Violates ProhibitCallsToUndeclaredSubs
	my @dialog_buttons = ();

	if (implements_udisks2_interface($device, 'Block')) {
		$dialog_title = get_block_device_path($device);
		$dialog_content .= 'Block device ID: ' . $device->Id . "\n";

		if ($device->IdUsage) {
			$dialog_content .= 'Reported usage: ' . $device->IdUsage . "\n";
		}

		if (implements_udisks2_interface($device, 'Partition')) {
			my $partition = $device->as_interface('org.freedesktop.UDisks2.Partition');
			my $humanized_size = $partition->Size / (2 ** 30);
			$dialog_content .= 'Partition size: ' . $humanized_size . ' GB' . "\n";
		}

		if (implements_udisks2_interface($device, 'PartitionTable')) {
			$dialog_content .= 'Partition Table: ' . $device->Type . "\n";
		}

		if (implements_udisks2_interface($device, 'Swapspace')) {
			my $swapspace = $device->as_interface('org.freedesktop.UDisks2.Swapspace');
			if ($swapspace->Active) {
				$dialog_content .= 'This swap space is active.';

				push @dialog_buttons,{
					-label => '< Swapoff >',
					-value => 'swapoff',
				}
			} else {
				$dialog_content .= 'This swap space is unused.';

				push @dialog_buttons,{
					-label => '< Swapon >',
					-value => 'swapon',
				}
			}
		}

		if (implements_udisks2_interface($device, 'Filesystem')) {
			$dialog_content .= 'Mountable filsystem: ' . $device->IdType . "\n";
			$dialog_content .= 'Mountpoints: ' . list_filesystem_mountpoints($device) . "\n";

			if (list_filesystem_mountpoints($device)) {
				push @dialog_buttons,{
					-label => '< Unmount >',
					-value => 'unmount',
				}
			}
			else {
				push @dialog_buttons,{
					-label => '< Mount >',
					-value => 'mount',
				}
			}
		}

		if (implements_udisks2_interface($device, 'Encrypted')) {
			$dialog_content .= 'Encrypted block device: ' . $device->IdType . "\n";
		}

	}
	elsif (implements_udisks2_interface($device, 'Drive')) {
		$dialog_title = $device->Vendor . ' ' . $device->Model;
		$dialog_content .= 'Drive ID: ' . $device->Id . "\n";
		$dialog_content .= 'Drive Size: ' . $device->Size . "\n";
	} else {
		$dialog_title = 'Error.';
		$dialog_content .= 'Could not find a valid object.';
	}

	# Append 'cancel' button to every dialog
	push @dialog_buttons, 'cancel';

	my $action = $cui->dialog(
		-title => $dialog_title,
		-message => $dialog_content,
		-buttons => \@dialog_buttons,
	);

	# Handle actions
	given ($action) {
		when (/^mount$/) {
			handle_udisks2_action($cui, sub { mount_filesystem($device) });
			refresh_listbox_content($udisks2, $listbox_values, $listbox_labels);
		}
		when (/^unmount$/) {
			handle_udisks2_action($cui, sub { unmount_filesystem($device) });
			refresh_listbox_content($udisks2, $listbox_values, $listbox_labels);
		}
		when (/^swapon$/) {
			handle_udisks2_action($cui, sub { active_swapspace($device) });
		}
		when (/^swapoff$/) {
			handle_udisks2_action($cui, sub { disable_swapspace($device) });
		}
	}

	# Refresh focus and selection
	$listbox->focus();
	$listbox->clear_selection();

	return;
}

sub main {
	my ($cui, $udisks2) = @_;

	# Define list content
	my $listbox_values = [];
	my $listbox_labels = {};
	refresh_listbox_content($udisks2, $listbox_values, $listbox_labels);

	# Define Curses UI components
	my $windows = define_curses_windows($cui);
	my $listbox = define_curses_listbox($cui, $windows->{main}, $udisks2, $listbox_values, $listbox_labels);
	populate_curses_windows($windows);
	define_curses_bindings($udisks2, $cui, $listbox, $listbox_values, $listbox_labels);

	$cui->mainloop();

	return;
}

### Initialization

sub init_script {
	my $cui = Curses::UI->new(-debug => 0);

	# FIXME: check for errors
	my $bus = Net::DBus->system;
	my $udisks2 = $bus->get_service('org.freedesktop.UDisks2');

	return ($cui, $udisks2);
}

my ($cui, $udisks2) = init_script();
main($cui, $udisks2);
