From ed7c1e1183d3a51f73cb2665ed19f29d2638e2c3 Mon Sep 17 00:00:00 2001
From: joerg <joerg@FreeBSD.org>
Date: Tue, 13 Feb 1996 13:17:49 +0000
Subject: Add a small `gethostname' package.  It uses __sysctl(2), and thus
 avoids the kludgy backquotes that are required by now (`hostname`).

Usage:

require "gethostname.pl";
$thishost = &gethostname'gethostname;
---
 gnu/usr.bin/perl/lib/Makefile       |  6 +++---
 gnu/usr.bin/perl/lib/gethostname.pl | 37 +++++++++++++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 3 deletions(-)
 create mode 100644 gnu/usr.bin/perl/lib/gethostname.pl

(limited to 'gnu/usr.bin')

diff --git a/gnu/usr.bin/perl/lib/Makefile b/gnu/usr.bin/perl/lib/Makefile
index 76398c8..158cbfa 100644
--- a/gnu/usr.bin/perl/lib/Makefile
+++ b/gnu/usr.bin/perl/lib/Makefile
@@ -2,9 +2,9 @@ PLIBDIR= ${DESTDIR}/usr/share/perl
 
 PLIB+= abbrev.pl assert.pl bigfloat.pl bigint.pl bigrat.pl cacheout.pl
 PLIB+= chat2.pl complete.pl ctime.pl dumpvar.pl exceptions.pl fastcwd.pl
-PLIB+= find.pl finddepth.pl flush.pl getcwd.pl getopts.pl importenv.pl
-PLIB+= look.pl newgetopt.pl open2.pl perldb.pl pwd.pl shellwords.pl
-PLIB+= stat.pl syslog.pl termcap.pl timelocal.pl validate.pl
+PLIB+= find.pl finddepth.pl flush.pl getcwd.pl gethostname.pl getopts.pl
+PLIB+= importenv.pl look.pl newgetopt.pl open2.pl perldb.pl pwd.pl
+PLIB+= shellwords.pl stat.pl syslog.pl termcap.pl timelocal.pl validate.pl
 
 NOOBJ=
 
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;
-- 
cgit v1.1