* Initial versions, to allow support for uname in posix.pp

rtl/bsd/bsduname.inc

@@ -0,0 +1,68 @@
+{
+    $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 based on the SYSCTL call.
+
+    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 uname(var name:utsname):cint;
+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 := errno;
+	if (sysctl(@mib, 2, pz, @len, NIL, 0) = -1) Then
+           Begin	
+		if (errno = sys_ENOMEM) Then
+			errno := 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);
+	Uname:=rval;
+end;	
+
+{
+ $Log$
+ Revision 1.1  2002-08-08 11:39:30  marco
+  * Initial versions, to allow support for uname in posix.pp
+
+
+
+}
+
+
+

rtl/bsd/sysctl.pp

@@ -0,0 +1,149 @@
+Unit sysctl;
+
+{  $Id$
+   This file is part of the Free Pascal run time library.
+   (c) 2002 by Marco van de Voort
+   member of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   sysctl.h header conversion, taken from FreeBSD 4.6, mainly as base
+   to implement UNAME on.
+
+   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.
+}
+
+Interface
+
+{$I ptypes.inc}
+
+{$Packrecords C}
+type psize_t=^size_t;
+
+{ 
+ * Copyright (c) 1989, 1993
+ *	The Regents of the University of California.  All rights reserved.
+ *
+ * This code is derived from software contributed to Berkeley by
+ * Mike Karels at Berkeley Software Design, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *	This product includes software developed by the University of
+ *	California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ *	@(#)sysctl.h	8.1 (Berkeley) 6/2/93
+ * $FreeBSD: src/sys/sys/sysctl.h,v 1.81.2.8 2002/03/17 11:08:38 alfred Exp $
+ }
+
+
+TYPE    CtlNameRec = Record
+		      Name: ansistring; {String[LongestStringInCtlNames]}
+		      CtlType:cint;
+		      end;	
+
+
+{$I sysctlh.inc}
+
+// sysctl only one that is tested. user_definable part of the sysctl
+// function is not implemented
+//
+
+function sys_sysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+function sys_sysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+function sys_sysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
+
+Implementation
+
+{$ifdef VER1_0}
+Uses Linux;	// yuck, I know.
+{$else}
+Uses Unix;  {Syscall functions}
+{$endif}
+
+{temporarily}
+
+{$ifdef FreeBSD}
+CONST  syscall_nr___sysctl                    = 202;
+{$endif}
+
+function sys_sysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+
+Begin
+	if (name[0] <> chr(CTL_USER)) Then
+	   exit(do_syscall(syscall_nr___sysctl,longint(name), namelen, longint(oldp), longint(oldlenp), longint(newp), longint(newlen)))
+	else
+	 Exit(0);
+End;
+
+function sys_sysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+Var
+	name2oid_oid 	: array[0..1] of cint;
+	real_oid     	: array[0..CTL_MAXNAME+1] of cint;
+	error 	     	: cint;
+	oidlen 		: size_t;
+Begin
+	name2oid_oid[0] := 0;	{This is magic & undocumented! }
+	name2oid_oid[1] := 3;
+
+	oidlen := sizeof(real_oid);
+	error := sys_sysctl(@name2oid_oid, 2, @real_oid, @oidlen, name,
+		       strlen(name));
+	if (error < 0)  Then
+		Exit(error);
+	oidlen := Oidlen DIV sizeof (cint);
+	error := sys_sysctl(@real_oid, oidlen, oldp, oldlenp, newp, newlen);
+	exit(error);
+End;
+
+function sys_sysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
+Var	oid   : array[0..1] OF cint;
+	error : cint;
+
+Begin
+	oid[0] := 0;
+	oid[1] := 3;
+	sizep^:=sizep^*sizeof(cint);
+	error := sys_sysctl(@oid, 2, mibp, sizep, name, strlen(name));
+	sizep^ := sizep^ div sizeof (cint);
+        
+	if (error < 0)  Then
+		Exit (error);
+	sys_sysctlnametomib:=0;
+End;
+
+end.
+
+{ 
+  $Log$
+  Revision 1.1  2002-08-08 11:39:30  marco
+   * Initial versions, to allow support for uname in posix.pp
+
+
+}