bsduname.inc 1.7 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 2001 by Free Pascal development team
  5. An *BSD implementation of Uname based on the SYSCTL call.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. function uname(var name:utsname):cint;
  13. Var
  14. mib : array[0..1] of cint;
  15. rval : cint;
  16. len : size_t;
  17. i : longint;
  18. oerrno : cint;
  19. procedure Doone(pz:pchar;pzsize:cint;val1,val2:cint);
  20. Begin
  21. mib[0] := val1;
  22. mib[1] := val2;
  23. len := pzsize;
  24. oerrno := errno;
  25. if (sysctl(@mib, 2, pz, @len, NIL, 0) = -1) Then
  26. Begin
  27. if (errno = sys_ENOMEM) Then
  28. errno := oerrno
  29. else
  30. rval := -1;
  31. End;
  32. pz[pzsize- 1] := #0;
  33. End;
  34. Begin
  35. rval := 0;
  36. DoOne(@name.sysname,sizeof(name.sysname),CTL_KERN,KERN_OSTYPE);
  37. DoOne(@name.nodename,sizeof(name.nodename),CTL_KERN,KERN_HOSTNAME);
  38. DoOne(@name.release,sizeof(name.release),CTL_KERN,KERN_OSRELEASE);
  39. { The version may have newlines in it, turn them into spaces. }
  40. DoOne(@name.version,sizeof(name.version),CTL_KERN,KERN_VERSION);
  41. For I:=0 to sizeof(name.sysname)-2 Do
  42. If (name.version[i]=#13) or (name.version[i]=#9) Then
  43. name.version[i]:=' ';
  44. DoOne(@name.machine,sizeof(name.machine),CTL_HW,HW_MACHINE);
  45. Uname:=rval;
  46. end;
  47. {
  48. $Log$
  49. Revision 1.1 2002-08-08 11:39:30 marco
  50. * Initial versions, to allow support for uname in posix.pp
  51. }