diff options
| author | joerg <joerg@FreeBSD.org> | 1996-02-13 13:17:49 +0000 |
|---|---|---|
| committer | joerg <joerg@FreeBSD.org> | 1996-02-13 13:17:49 +0000 |
| commit | ed7c1e1183d3a51f73cb2665ed19f29d2638e2c3 (patch) | |
| tree | cae89f28efbdfe6d623a109a11da6002d19990c3 /gnu/usr.bin/perl | |
| parent | 796e5c4e86b5273a5482e8db4c892553969a6155 (diff) | |
| download | FreeBSD-src-ed7c1e1183d3a51f73cb2665ed19f29d2638e2c3.zip FreeBSD-src-ed7c1e1183d3a51f73cb2665ed19f29d2638e2c3.tar.gz | |
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;
Diffstat (limited to 'gnu/usr.bin/perl')
| -rw-r--r-- | gnu/usr.bin/perl/lib/Makefile | 6 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/gethostname.pl | 37 |
2 files changed, 40 insertions, 3 deletions
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; |
