1 files changed, 37 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/lib/gethostname.pl b/gnu/usr.bin/perl/lib/gethostname.pl
new file mode 100644
index 0000000..626d49d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/gethostname.pl
@@ -0,0 +1,37 @@
+#
+# Simple package to get the hostname via __sysctl(2).
+#
+# Written 13-Feb-96 by Jörg Wunsch, interface business GmbH Dresden.
+# Placed in the public domain.
+#
+# $Id$
+#
+
+package gethostname;
+
+require "sys/syscall.ph";
+require "sys/sysctl.ph";
+
+#
+# usage:
+#
+# require "gethostname.pl";
+# printf "This machine is named \"%s\".\n", &gethostname'gethostname;
+#
+
+sub gethostname {
+    # get hostname via sysctl(2)
+    local($name, $oldval, $oldlen, $len);
+    $name = pack("LL", &CTL_KERN, &KERN_HOSTNAME);
+    # 64-byte string to get the hostname
+    $oldval =
+	"                                                                ";
+    $oldlen = pack("L", length($oldval));
+    syscall(&SYS___sysctl, $name, 2, $oldval, $oldlen, 0, 0) != -1 ||
+	die "Cannot get hostname via sysctl(2), errno = $!\n";
+
+    ($len) = unpack("L", $oldlen);
+    return substr($oldval, 0, $len);
+}
+
+1;