From 1e5f02d6345e17a4d918be74da9106c79032a730 Mon Sep 17 00:00:00 2001 From: Martin Whitaker Date: Mon, 4 May 2020 10:53:39 +0100 Subject: Convert to udisks2. --- lib/Hal/Cdroms.pm | 102 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 57 insertions(+), 45 deletions(-) diff --git a/lib/Hal/Cdroms.pm b/lib/Hal/Cdroms.pm index b171e5a..3da8490 100644 --- a/lib/Hal/Cdroms.pm +++ b/lib/Hal/Cdroms.pm @@ -44,7 +44,7 @@ Access cdroms through HAL and D-Bus. =cut # internal constant -my $dn = 'org.freedesktop.UDisks'; +my $dn = 'org.freedesktop.UDisks2'; =head2 Hal::Cdroms->new @@ -73,11 +73,9 @@ Returns the list of C of the cdroms (mounted or not). sub list { my ($o) = @_; - my $manager = $o->{service}->get_object("/org/freedesktop/UDisks", - $dn); + my $manager = $o->{service}->get_object('/org/freedesktop/UDisks2/Manager'); - - grep { _GetProperty(_get_device($o, $_), 'DeviceIsOpticalDisc') } @{$manager->EnumerateDevices}; + grep { _is_cdrom($o, $_); } @{$manager->GetBlockDevices(undef)}; } =head2 $cdroms->get_mount_point($udisks_path) @@ -86,32 +84,46 @@ Return the mount point associated to the C, or undef it is not moun =cut -sub _get_udisks_device { +sub _is_cdrom { my ($o, $udisks_path) = @_; - $o->{service}->get_object($udisks_path, "$dn.Device"); + my $device = _get_device($o, $udisks_path); + my $drive = _get_drive($o, $device); + return unless $drive && _get_property($drive, 'Drive', 'Optical'); + eval { _get_property($device, 'Filesystem', 'MountPoints') }; } sub _get_device { - my ($o, $udisks_path) = @_; - $o->{service}->get_object($udisks_path, 'org.freedesktop.DBus.Properties'); + my ($o, $udisks_path, $o_interface_name) = @_; + $o->{service}->get_object($udisks_path, $o_interface_name); } -sub _get_volume { - my ($o, $udisks_path) = @_; - $o->{service}->get_object($udisks_path, "$dn.Device.Volume"); +sub _get_drive { + my ($o, $device) = @_; + my $drive_path = _get_property($device, 'Block', 'Drive'); + return if $drive_path eq '/'; + $o->{service}->get_object($drive_path); } -sub _GetProperty { - my ($device, $pname) = @_; - $device->Get('org.freedesktop.DBus.Properties', $pname); +sub _get_property { + my ($device, $interface_name, $property_name) = @_; + $device->Get("$dn.$interface_name", $property_name); } sub get_mount_point { my ($o, $udisks_path) = @_; + my $mounts = _get_mount_points($o, $udisks_path); + _int_array_to_string($$mounts[0]) if @{$mounts}; +} +sub _get_mount_points { + my ($o, $udisks_path) = @_; my $device = _get_device($o, $udisks_path); - eval { _GetProperty($device, 'DeviceIsMounted') - && @{_GetProperty($device, 'DeviceMountPaths')}[0] }; + eval { _get_property($device, 'Filesystem', 'MountPoints') } || []; +} + +sub _int_array_to_string { + my ($array) = @_; + join('', map { $_ ? chr($_) : '' } @{$array}); } sub _try { @@ -152,10 +164,10 @@ If the cdrom is listed in fstab, HAL will refuse to mount it. sub mount_hal { my ($o, $udisks_path) = @_; - my $device = _get_udisks_device($o, $udisks_path); + my $device = _get_device($o, $udisks_path, "$dn.Filesystem"); my $mountpoint; - _try($o, sub { $mountpoint = $device->FilesystemMount(undef, []) }) or return; + _try($o, sub { $mountpoint = $device->Mount(undef) }) or return; $mountpoint; } @@ -172,9 +184,8 @@ sub mount { my $mntpoint = mount_hal($o, $udisks_path); if (!$mntpoint) { # this usually means HAL refused to mount a cdrom listed in fstab - my $dev = _GetProperty(_get_device($o, $udisks_path), 'NativePath'); - # try to get real path: - $dev =~ s!.*/!/dev/!; + my $device = _get_device($o, $udisks_path); + my $dev = _int_array_to_string(_get_property($device, 'Block', 'Device')); if (my $wanted = $dev && _rdev($dev)) { my ($fstab_dev) = grep { $wanted == _rdev($_) } _fstab_devices(); system("mount", $fstab_dev) == 0 @@ -203,8 +214,8 @@ If the cdrom is listed in not mounted by HAL, HAL will refuse to unmount it. sub unmount_hal { my ($o, $udisks_path) = @_; - my $volume = _get_udisks_device($o, $udisks_path); - _try($o, sub { $volume->FilesystemUnmount([]) }); + my $device = _get_device($o, $udisks_path, "$dn.Filesystem"); + _try($o, sub { $device->Unmount(undef) }); } =head2 $cdroms->unmount($udisks_path) @@ -231,8 +242,9 @@ Ejects the C. Return true on success (see $cdroms->{error} on failu sub eject { my ($o, $udisks_path) = @_; - my $volume = _get_udisks_device($o, $udisks_path); - _try($o, sub { $volume->FilesystemUnmount([]); $volume->DriveEject([]) }); + my $device = _get_device($o, $udisks_path); + my $drive = _get_drive($o, $device); + _try($o, sub { $device->as_interface("$dn.Filesystem")->Unmount(undef); $drive->Eject(undef) }); } =head2 $cdroms->wait_for_insert([$timeout]) @@ -249,11 +261,13 @@ sub wait_for_insert { return if $o->list; - _reactor_wait($o->{dbus}, $dn, $o_timeout, sub { + _reactor_wait($o->{dbus}, $o_timeout, sub { my ($msg) = @_; - my $path; - return unless member($msg->get_member, 'DeviceChanged', 'DeviceAdded') && ($path = ($msg->get_args_list)[0]); - _GetProperty(_get_device($o, $path), 'DeviceIsOpticalDisc'); + return unless $msg->get_member eq 'InterfacesAdded'; + my $udisks_path = ($msg->get_args_list)[0]; + return unless $udisks_path =~ /block_devices/; + return unless _is_cdrom($o, $udisks_path); + $udisks_path; }); } @@ -269,32 +283,30 @@ You can give an optional timeout in milliseconds. sub wait_for_mounted { my ($o, $o_timeout) = @_; - _reactor_wait($o->{dbus}, $dn, $o_timeout, sub { + _reactor_wait($o->{dbus}, $o_timeout, sub { my ($msg) = @_; - $msg->get_member eq 'PropertyModified' or return; - - my (undef, $modified_properties) = $msg->get_args_list; - grep { $_->[0] eq 'volume.is_mounted' } @$modified_properties or return; - - my $udisks_path = $msg->get_path; - my $device = _get_device($o, $udisks_path); - - eval { _GetProperty($device, 'DeviceIsMounted') } && $udisks_path; + return unless member($msg->get_member, 'InterfacesAdded', 'PropertiesChanged'); + my $udisks_path = $msg->get_member eq 'InterfacesAdded' ? ($msg->get_args_list)[0] : $msg->get_path; + return unless $udisks_path =~ /block_devices/; + return unless _is_cdrom($o, $udisks_path); + return unless @{_get_mount_points($o, $udisks_path)} > 0; + $udisks_path; }); } sub _reactor_wait { - my ($dbus, $interface, $timeout, $check_found) = @_; + my ($dbus, $timeout, $check_found) = @_; - my $val; + my $found_val; my $reactor = Net::DBus::Reactor->main; my $con = $dbus->get_connection; - $con->add_match("type='signal',interface='$interface'"); + $con->add_match("type='signal',sender='$dn'"); $con->add_filter(sub { my ($_con, $msg) = @_; - if ($val = $check_found->($msg)) { + if (my $val = $check_found->($msg)) { + $found_val = $val; _reactor_shutdown($reactor); } }); @@ -305,7 +317,7 @@ sub _reactor_wait { } $reactor->run; - $val; + $found_val; } sub _reactor_shutdown { -- cgit v1.2.1