Hi Daniel,
I've got a patch for perl-Net-DBus that adds support for the interactive
authorization stuff currently in dbus-1.9.x branch.
It seems to work well when using it but will need a little polish to
make work nicely when complied against different versions of dbus (e.g.
compiling against older version that doesn't have the appropriate
getter/setter methods).
Before I polish it and get it over to you, what is the definitive VCS
for it?
I think it's https://gitorious.org/net-dbus is this correct?
I've attached the WIP patch FYI, but feel free to ignore it until a
properly git formatted patch is available.
FWIW, this would also address this issue:
https://rt.cpan.org/Public/Bug/Display.html?id=101369
All the best
Col
--
Colin Guthrie
colin(at)mageia.org
http://colin.guthr.ie/
Day Job:
Tribalogic Limited http://www.tribalogic.net/
Open Source:
Mageia Contributor http://www.mageia.org/
PulseAudio Hacker http://www.pulseaudio.org/
Trac Hacker http://trac.edgewall.org/
diff -u -r Net-DBus-1.0.0.orig/DBus.xs Net-DBus-1.0.0/DBus.xs
--- Net-DBus-1.0.0.orig/DBus.xs 2011-06-30 22:32:04.000000000 +0100
+++ Net-DBus-1.0.0/DBus.xs 2015-01-07 14:10:05.955498879 +0000
@@ -997,6 +997,15 @@
DBusMessage *msg;
dbus_bool_t flag;
+dbus_bool_t
+dbus_message_get_allow_interactive_authorization(msg)
+ DBusMessage *msg;
+
+void
+dbus_message_set_allow_interactive_authorization(msg,flag)
+ DBusMessage *msg;
+ dbus_bool_t flag;
+
int
dbus_message_get_type(msg)
DBusMessage *msg;
diff -u -r Net-DBus-1.0.0.orig/lib/Net/DBus/Annotation.pm Net-DBus-1.0.0/lib/Net/DBus/Annotation.pm
--- Net-DBus-1.0.0.orig/lib/Net/DBus/Annotation.pm 2011-06-30 22:32:04.000000000 +0100
+++ Net-DBus-1.0.0/lib/Net/DBus/Annotation.pm 2015-01-07 14:13:47.763262283 +0000
@@ -64,16 +64,20 @@
our $CALL_SYNC = "sync";
our $CALL_ASYNC = "async";
our $CALL_NOREPLY = "noreply";
+our $AUTH_NONE = "auth_none";
+our $AUTH_INTERACTIVE = "auth_interactive";
bless \$CALL_SYNC, __PACKAGE__;
bless \$CALL_ASYNC, __PACKAGE__;
bless \$CALL_NOREPLY, __PACKAGE__;
+bless \$AUTH_NONE, __PACKAGE__;
+bless \$AUTH_INTERACTIVE, __PACKAGE__;
require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(dbus_call_sync dbus_call_async dbus_call_noreply);
-our %EXPORT_TAGS = (call => [qw(dbus_call_sync dbus_call_async dbus_call_noreply)]);
+our @EXPORT_OK = qw(dbus_call_sync dbus_call_async dbus_call_noreply dbus_auth_none dbus_auth_interactive);
+our %EXPORT_TAGS = (call => [qw(dbus_call_sync dbus_call_async dbus_call_noreply)], auth => [qw(dbus_auth_none dbus_auth_interactive)]);
=item dbus_call_sync
@@ -110,6 +114,26 @@
return \$CALL_NOREPLY;
}
+=item dbus_auth_none
+
+Requests that a method call disallows interactive authorization.
+
+=cut
+
+sub dbus_auth_none() {
+ return \$AUTH_NONE;
+}
+
+=item dbus_auth_interactive
+
+Requests that a method call allows interactive authorization.
+
+=cut
+
+sub dbus_auth_interactive() {
+ return \$AUTH_INTERACTIVE;
+}
+
1;
=pod
diff -u -r Net-DBus-1.0.0.orig/lib/Net/DBus/Binding/Message.pm Net-DBus-1.0.0/lib/Net/DBus/Binding/Message.pm
--- Net-DBus-1.0.0.orig/lib/Net/DBus/Binding/Message.pm 2011-06-30 22:32:04.000000000 +0100
+++ Net-DBus-1.0.0/lib/Net/DBus/Binding/Message.pm 2015-01-07 14:10:05.955498879 +0000
@@ -375,6 +375,34 @@
$self->{message}->dbus_message_set_no_reply($flag);
}
+=item $boolean = $msg->get_allow_interactive_authorization()
+
+Gets the flag indicating whether the message allows
+interactive authorization.
+
+=cut
+
+sub get_allow_interactive_authorization {
+ my $self = shift;
+
+ return $self->{message}->dbus_message_get_allow_interactive_authorization;
+}
+
+=item $msg->set_allow_interactive_authorization($boolean)
+
+Toggles the flag indicating whether the message allows
+interactive authorization.
+
+=cut
+
+
+sub set_allow_interactive_authorization {
+ my $self = shift;
+ my $flag = shift;
+
+ $self->{message}->dbus_message_set_allow_interactive_authorization($flag);
+}
+
=item my @values = $msg->get_args_list
De-marshall all the values in the body of the message, using the
diff -u -r Net-DBus-1.0.0.orig/lib/Net/DBus/RemoteObject.pm Net-DBus-1.0.0/lib/Net/DBus/RemoteObject.pm
--- Net-DBus-1.0.0.orig/lib/Net/DBus/RemoteObject.pm 2011-06-30 22:32:04.000000000 +0100
+++ Net-DBus-1.0.0/lib/Net/DBus/RemoteObject.pm 2015-01-07 14:21:46.022922890 +0000
@@ -57,7 +57,7 @@
use Net::DBus::Binding::Introspector;
use Net::DBus::ASyncReply;
-use Net::DBus::Annotation qw(:call);
+use Net::DBus::Annotation qw(:call :auth);
=item my $object = Net::DBus::RemoteObject->new($service, $object_path[, $interface]);
@@ -341,8 +341,14 @@
my $sub = $AUTOLOAD;
my $mode = dbus_call_sync;
- if (@_ && UNIVERSAL::isa($_[0], "Net::DBus::Annotation")) {
- $mode = shift;
+ my $auth = dbus_auth_none;
+ while (@_ && UNIVERSAL::isa($_[0], "Net::DBus::Annotation")) {
+ my $annotation = shift;
+ if ($annotation == dbus_call_sync || $annotation == dbus_call_async || $annotation == dbus_call_noreply) {
+ $mode = $annotation;
+ } elsif ($annotation == dbus_auth_none || $annotation == dbus_auth_interactive) {
+ $auth = $annotation;
+ }
}
(my $name = $AUTOLOAD) =~ s/.*:://;
@@ -356,7 +362,7 @@
if ($ins) {
if ($interface) {
if ($ins->has_method($name, $interface)) {
- return $self->_call_method($mode, $name, $interface, 1, @_);
+ return $self->_call_method($auth, $mode, $name, $interface, 1, @_);
}
if ($ins->has_property($name, $interface)) {
if ($ins->is_property_deprecated($name, $interface)) {
@@ -364,10 +370,10 @@
}
if (@_) {
- $self->_call_method($mode, "Set", "org.freedesktop.DBus.Properties", $interface, 1, $name, $_[0]);
+ $self->_call_method($auth, $mode, "Set", "org.freedesktop.DBus.Properties", $interface, 1, $name, $_[0]);
return ();
} else {
- return $self->_call_method($mode, "Get", "org.freedesktop.DBus.Properties", $interface, 1, $name);
+ return $self->_call_method($auth, $mode, "Get", "org.freedesktop.DBus.Properties", $interface, 1, $name);
}
}
} else {
@@ -378,7 +384,7 @@
die "method with name '$name' is exported " .
"in multiple interfaces of '" . $self->get_object_path . "'";
}
- return $self->_call_method($mode, $name, $interfaces[0], 1, @_);
+ return $self->_call_method($auth, $mode, $name, $interfaces[0], 1, @_);
}
@interfaces = $ins->has_property($name);
@@ -392,10 +398,10 @@
warn "property $name in interface $interface on " . $self->get_object_path . " is deprecated";
}
if (@_) {
- $self->_call_method($mode, "Set", "org.freedesktop.DBus.Properties", $interface, 1, $name, $_[0]);
+ $self->_call_method($auth, $mode, "Set", "org.freedesktop.DBus.Properties", $interface, 1, $name, $_[0]);
return ();
} else {
- return $self->_call_method($mode, "Get", "org.freedesktop.DBus.Properties", $interface, 1, $name);
+ return $self->_call_method($auth, $mode, "Get", "org.freedesktop.DBus.Properties", $interface, 1, $name);
}
}
}
@@ -406,12 +412,13 @@
$self->get_object_path . "', and object is not cast to any interface";
}
- return $self->_call_method($mode, $name, $interface, 0, @_);
+ return $self->_call_method($auth, $mode, $name, $interface, 0, @_);
}
sub _call_method {
my $self = shift;
+ my $auth = shift;
my $mode = shift;
my $name = shift;
my $interface = shift;
@@ -438,6 +445,10 @@
$call->append_args_list(@_);
}
+ if ($auth == dbus_auth_interactive) {
+ $call->set_allow_interactive_authorization(1);
+ }
+
if ($mode == dbus_call_sync) {
my $reply = $con->
send_with_reply_and_block($call, 60 * 1000);
_______________________________________________
systemd-devel mailing list
systemd-devel@lists.freedesktop.org
http://lists.freedesktop.org/mailman/listinfo/systemd-devel
