diff options
Diffstat (limited to 'gnu')
| -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; |
