[libnet-dbus-perl] 311/335: Add support for UNIX file descriptor passing
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:08:14 UTC 2015
This is an automated email from the git hooks/post-receive script.
intrigeri pushed a commit to branch experimental
in repository libnet-dbus-perl.
commit 5bf227d1b499bb083b59da0b14f92bd8c78f419e
Author: Manuel Reimer <manuel.reimer at gmx.de>
Date: Sun Apr 7 12:04:38 2013 +0100
Add support for UNIX file descriptor passing
Signed-off-by: Daniel P. Berrange <dan at berrange.com>
---
AUTHORS | 2 +-
DBus.xs | 18 ++++++++++++++++++
Makefile.PL | 5 +++++
lib/Net/DBus.pm | 15 +++++++++++++--
lib/Net/DBus/Binding/Introspector.pm | 2 ++
lib/Net/DBus/Binding/Iterator.pm | 9 +++++++++
lib/Net/DBus/Binding/Message.pm | 5 +++++
lib/Net/DBus/Test/MockIterator.pm | 23 +++++++++++++++++++++++
t/15-message.t | 16 +++++++++++++++-
9 files changed, 91 insertions(+), 4 deletions(-)
diff --git a/AUTHORS b/AUTHORS
index 78352b9..8d5faef 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -17,7 +17,7 @@ from
Pavel Strashkin <pavel.strashkin at gmail.com>
Mathieu Bridon <bochecha at fedoraproject.org>
Frank Szczerba <frank at szczerba.net>
-
+ Manuel Reimer <manuel.reimer at gmx.de>
[...send patches to get your name here!]
diff --git a/DBus.xs b/DBus.xs
index 5295eb6..6f63c43 100644
--- a/DBus.xs
+++ b/DBus.xs
@@ -498,6 +498,7 @@ BOOT:
REGISTER_CONSTANT(DBUS_TYPE_UINT32, TYPE_UINT32);
REGISTER_CONSTANT(DBUS_TYPE_UINT64, TYPE_UINT64);
REGISTER_CONSTANT(DBUS_TYPE_VARIANT, TYPE_VARIANT);
+ REGISTER_CONSTANT(DBUS_TYPE_UNIX_FD, TYPE_UNIX_FD);
REGISTER_CONSTANT(DBUS_MESSAGE_TYPE_METHOD_CALL, MESSAGE_TYPE_METHOD_CALL);
REGISTER_CONSTANT(DBUS_MESSAGE_TYPE_METHOD_RETURN, MESSAGE_TYPE_METHOD_RETURN);
@@ -1444,6 +1445,14 @@ get_object_path(iter)
OUTPUT:
RETVAL
+dbus_uint32_t
+get_unix_fd(iter)
+ DBusMessageIter *iter;
+ CODE:
+ dbus_message_iter_get_basic(iter, &RETVAL);
+ OUTPUT:
+ RETVAL
+
void
append_boolean(iter, val)
@@ -1553,6 +1562,15 @@ append_signature(iter, val)
croak("cannot append signature");
}
+void
+append_unix_fd(iter, val)
+ DBusMessageIter *iter;
+ dbus_uint32_t val;
+ CODE:
+ if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_UNIX_FD, &val)) {
+ croak("cannot append UNIX fd");
+ }
+
void
diff --git a/Makefile.PL b/Makefile.PL
index 2973a69..c68bcb2 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,6 +3,11 @@ use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
+my $dbusver = "1.3.0";
+my $stat = system "pkg-config --atleast-version=$dbusver dbus-1";
+die "cannot run pkg-config to check dbus version" if $stat == -1;
+die "DBus >= $dbusver is required\n" unless $stat == 0;
+
my $DBUS_LIBS = `pkg-config --libs dbus-1`;
my $DBUS_CFLAGS = `pkg-config --cflags dbus-1`;
diff --git a/lib/Net/DBus.pm b/lib/Net/DBus.pm
index 84ccc20..691261b 100644
--- a/lib/Net/DBus.pm
+++ b/lib/Net/DBus.pm
@@ -722,7 +722,7 @@ Mark a value as being a dictionary
=cut
-sub dbus_dict{
+sub dbus_dict {
return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_DICT_ENTRY],
$_[0]);
}
@@ -733,11 +733,22 @@ Mark a value as being a variant
=cut
-sub dbus_variant{
+sub dbus_variant {
return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_VARIANT],
$_[0]);
}
+=item $typed_value = dbus_unix_fd($value);
+
+Mark a value as being a unix file descriptor
+
+=cut
+
+sub dbus_unix_fd {
+ return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_UNIX_FD],
+ $_[0]);
+}
+
=pod
=back
diff --git a/lib/Net/DBus/Binding/Introspector.pm b/lib/Net/DBus/Binding/Introspector.pm
index 2d35e20..e286c67 100644
--- a/lib/Net/DBus/Binding/Introspector.pm
+++ b/lib/Net/DBus/Binding/Introspector.pm
@@ -80,6 +80,7 @@ our %simple_type_map = (
"uint64" => &Net::DBus::Binding::Message::TYPE_UINT64,
"objectpath" => &Net::DBus::Binding::Message::TYPE_OBJECT_PATH,
"signature" => &Net::DBus::Binding::Message::TYPE_SIGNATURE,
+ "unixfd" => &Net::DBus::Binding::Message::TYPE_UNIX_FD,
);
our %simple_type_rev_map = (
@@ -95,6 +96,7 @@ our %simple_type_rev_map = (
&Net::DBus::Binding::Message::TYPE_UINT64 => "uint64",
&Net::DBus::Binding::Message::TYPE_OBJECT_PATH => "objectpath",
&Net::DBus::Binding::Message::TYPE_SIGNATURE => "signature",
+ &Net::DBus::Binding::Message::TYPE_UNIX_FD => "unixfd",
);
our %magic_type_map = (
diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index 6d5fdac..74a7ded 100644
--- a/lib/Net/DBus/Binding/Iterator.pm
+++ b/lib/Net/DBus/Binding/Iterator.pm
@@ -170,6 +170,13 @@ build of Perl does not support 64 bit integers
Read or write a double precision floating point value
from/to the message iterator
+=item my $val = $iter->get_unix_fd()
+
+=item $iter->append_unix_fd($val);
+
+Read or write a unix_fd value from/to the
+message iterator
+
=cut
sub get_int64 {
@@ -277,6 +284,8 @@ sub get {
return $self->get_object_path();
} elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
return $self->get_signature();
+ } elsif ($type == &Net::DBus::Binding::Message::TYPE_UNIX_FD) {
+ return $self->get_unix_fd();
} else {
die "unknown argument type '" . chr($type) . "' ($type)";
}
diff --git a/lib/Net/DBus/Binding/Message.pm b/lib/Net/DBus/Binding/Message.pm
index 2c12a16..5d2585a 100644
--- a/lib/Net/DBus/Binding/Message.pm
+++ b/lib/Net/DBus/Binding/Message.pm
@@ -131,6 +131,11 @@ unsigned 64 bit integer data type.
Constant representing the signature value associated with the
variant data type.
+=item TYPE_UNIX_FD
+
+Constant representing the signature value associated with the
+unix file descriptor data type.
+
=back
=head1 METHODS
diff --git a/lib/Net/DBus/Test/MockIterator.pm b/lib/Net/DBus/Test/MockIterator.pm
index 125a879..4130d00 100644
--- a/lib/Net/DBus/Test/MockIterator.pm
+++ b/lib/Net/DBus/Test/MockIterator.pm
@@ -361,6 +361,25 @@ sub append_double {
}
+=item my $val = $iter->get_unix_fd()
+
+=item $iter->append_unix_fd($val);
+
+Read or write a unix_fd value from/to the
+message iterator
+
+=cut
+
+sub get_unix_fd {
+ my $self = shift;
+ return $self->_get(&Net::DBus::Binding::Message::TYPE_UNIX_FD);
+}
+
+sub append_unix_fd {
+ my $self = shift;
+ $self->_append(&Net::DBus::Binding::Message::TYPE_UNIX_FD, $_[0] ? 1 : "");
+}
+
=item my $value = $iter->get()
@@ -442,6 +461,8 @@ sub get {
return $self->get_object_path();
} elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
return $self->get_signature();
+ } elsif ($type == &Net::DBus::Binding::Message::TYPE_UNIX_FD) {
+ return $self->get_unix_fd;
} else {
die "unknown argument type '" . chr($type) . "' ($type)";
}
@@ -618,6 +639,8 @@ sub append {
$self->append_object_path($value);
} elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
$self->append_signature($value);
+ } elsif ($type == &Net::DBus::Binding::Message::TYPE_UNIX_FD) {
+ $self->append_unix_fd($value);
} else {
die "Unsupported scalar type ", $type, " ('", chr($type), "')";
}
diff --git a/t/15-message.t b/t/15-message.t
index d07c221..5681bd8 100644
--- a/t/15-message.t
+++ b/t/15-message.t
@@ -1,5 +1,7 @@
# -*- perl -*-
-use Test::More tests => 33;
+use Test::More tests => 35;
+
+use File::Temp qw/tempfile/;
use strict;
use warnings;
@@ -31,6 +33,12 @@ $iter->append_uint64("12312312312123456");
$iter->append_string("Hello world");
$iter->append_double(1.424141);
+my $fh = tempfile(UNLINK => 1);
+print $fh "Hello World\n";
+seek $fh, 0, 0;
+
+$iter->append_unix_fd($fh->fileno);
+
$iter->append_array(["one", "two", "three"], [&Net::DBus::Binding::Message::TYPE_STRING]);
$iter->append_dict({ "one" => "foo", "two" => "bar"}, [&Net::DBus::Binding::Message::TYPE_STRING,
@@ -70,6 +78,12 @@ my $d = $iter->get_double();
ok($d > 1.424100 && $d < 1.424200, "double");
ok($iter->next(), "next");
+my $fh2 = IO::Handle->new();
+$fh2->fdopen($iter->get_unix_fd(), "r");
+my $data = <$fh2>;
+ok($data eq "Hello World\n");
+
+ok($iter->next(), "next");
is_deeply($iter->get_array(&Net::DBus::Binding::Message::TYPE_STRING), ["one", "two", "three"], "array");
ok($iter->next(), "next");
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git
More information about the Pkg-perl-cvs-commits
mailing list