123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110 |
- {
- $Id$
- This file is part of the Free Pascal run time library.
- Copyright (c) 2001 by Free Pascal development team
- An *BSD implementation of Uname and in the future some more
- calls.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- function sys_uname(var name:utsname):cint; external name 'FPC_SYSC_UNAME';
- Var
- mib : array[0..1] of cint;
- rval : cint;
- len : size_t;
- i : longint;
- oerrno : cint;
- procedure Doone(pz:pchar;pzsize:cint;val1,val2:cint);
- Begin
- mib[0] := val1;
- mib[1] := val2;
- len := pzsize;
- oerrno := geterrno;
- if (sys_sysctl(@mib, 2, pz, @len, NIL, 0) = -1) Then
- Begin
- if (geterrno = sys_ENOMEM) Then
- seterrno(oerrno)
- else
- rval := -1;
- End;
- pz[pzsize- 1] := #0;
- End;
- Begin
- rval := 0;
- DoOne(@name.sysname,sizeof(name.sysname),CTL_KERN,KERN_OSTYPE);
- DoOne(@name.nodename,sizeof(name.nodename),CTL_KERN,KERN_HOSTNAME);
- DoOne(@name.release,sizeof(name.release),CTL_KERN,KERN_OSRELEASE);
- { The version may have newlines in it, turn them into spaces. }
- DoOne(@name.version,sizeof(name.version),CTL_KERN,KERN_VERSION);
- For I:=0 to sizeof(name.sysname)-2 Do
- If (name.version[i]=#13) or (name.version[i]=#9) Then
- name.version[i]:=' ';
- DoOne(@name.machine,sizeof(name.machine),CTL_HW,HW_MACHINE);
- sys_Uname:=rval;
- end;
- function GetDomainName(Name:PChar; NameLen:Cint):cint; external name 'FPC_SYSC_GETDOMAINNAME';
- Const Mib_GetDomainName : array[0..1] of cint=(CTL_KERN,KERN_NISDOMAINNAME);
- VAR
- tsize : size_t;
- begin
- tsize := namelen;
- if (sys_sysctl(@Mib_GetDomainname, 2, name, @tsize, NIL, 0) = -1) Then
- GetDomainName:=-1
- Else
- GetDomainName:=0;
- end;
- function GetHostName(Name:PChar; NameLen:Cint):cint; external name 'FPC_SYSC_GETHOSTNAME';
- Const Mib_GetHostName : array[0..1] of cint=(CTL_KERN,KERN_HOSTNAME);
- Var
- tsize : size_t;
- begin
- tsize := namelen;
- if (sys_sysctl(@Mib_GetHostName, 2, name, @tsize, NIL, 0) = -1) Then
- GetHostName:=-1
- Else
- GetHostName:=0;
- End;
- {
- $Log$
- Revision 1.4 2002-09-08 16:20:27 marco
- * Forgot external name's
- Revision 1.3 2002/09/08 16:11:59 marco
- * Added GetDomainName and that other one ..
- Revision 1.2 2002/09/07 16:01:17 peter
- * old logs removed and tabs fixed
- Revision 1.1 2002/08/21 07:03:16 marco
- * Fixes from Tuesday.
- Revision 1.1 2002/08/08 11:39:30 marco
- * Initial versions, to allow support for uname in posix.pp
- }
|