File : posix-sockets-local.adb
------------------------------------------------------------------------------
-- --
-- POSIX Ada95 Bindings for Protocol Independent Interfaces (P1003.5c) --
-- --
-- P O S I X . S o c k e t s . L o c a l --
-- --
-- B o d y --
-- --
-- --
-- Copyright (c) 1997 Lockheed Martin Corporation, All Rights Reserved. --
-- --
-- This file is part of an implementation of an Ada95 API for the sockets --
-- and network support services found in P1003.1g -- Protocol Independent --
-- Interfaces. It is integrated with the FSU Implementation of POSIX.5b --
-- (FLORIST), an Ada API for POSIX OS services for use with the GNAT Ada --
-- compiler and the FSU Gnu Ada Runtime Library (GNARL). The interface is --
-- intended to be close to those specified in IEEE STD 1003.5: 1990, IEEE --
-- STD 1003.5b: 1996, and IEEE Draft STD 1003.5c: 1997. --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 2, or (at your option) any later --
-- version. This software 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. See the GNU --
-- General Public License for more details. You should have received a --
-- copy of the GNU General Public License distributed with GNARL; see --
-- file COPYING. If not, write to the Free Software Foundation, 59 --
-- Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
------------------------------------------------------------------------------
with POSIX.C; use POSIX.C;
with GNAT.IO; use GNAT.IO;
with POSIX.Implementation; use POSIX.Implementation;
with Unchecked_Conversion;
with System;
package body POSIX.Sockets.Local is
use POSIX.C.Sockets;
use POSIX.C.NetDB;
-- unchecked conversions
function To_Ptr is
new Unchecked_Conversion (sockaddr_ptr, sockaddr_un_ptr);
function To_Ptr is
new Unchecked_Conversion (char_ptr, sockaddr_un_ptr);
function "+" is
new Unchecked_Conversion (sockaddr_un_ptr, sockaddr_var_ptr);
----------------------------------
-- Local IPC Socket Addresses --
----------------------------------
function Get_Socket_Path (Name : Local_Socket_Address)
return POSIX.Pathname is
Length : Integer := 0;
begin
for I in Name.C.sun_path'Range loop
exit when Name.C.sun_path (I) = NUL;
Length := Length + 1;
end loop;
return Name.C.sun_path (Name.C.sun_path'First .. Length);
end Get_Socket_Path;
procedure Set_Socket_Path
(Name : in out Local_Socket_Address;
Path : in POSIX.Pathname) is
Path_With_NUL : POSIX.Pathname := Path & NUL;
begin
Name.C.sun_path (Path_With_NUL'First .. Path_With_NUL'Last)
:= Path_With_NUL;
end Set_Socket_Path;
-------------------------------------------------------
-- tagged operations for type Local_Socket_Address --
-------------------------------------------------------
function Address (Name : Local_Socket_Address)
return POSIX.C.Sockets.sockaddr_var_ptr is
begin
return +Name.C'Unchecked_Access;
end Address;
function Length (Name : Local_Socket_Address)
return POSIX.C.size_t is
begin
for I in Name.C.sun_path'Range loop
if Name.C.sun_path (I) = NUL then
return size_t (I + (Name.C.sun_family'Size / System.Storage_Unit));
end if;
end loop;
-- if no null was found return zero length
return 0;
end Length;
---------------------
-- Get_Peer_Name --
---------------------
function c_getpeername
(s : int; socketaddress : sockaddr_var_ptr;
addresslen : size_t_var_ptr) return int;
pragma Import (C, c_getpeername, getpeername_LINKNAME);
function Get_Peer_Name (Socket : POSIX.IO.File_Descriptor)
return Local_Socket_Address is
c_address : aliased struct_sockaddr_un;
c_address_len : aliased size_t := c_address'Size / char'Size;
begin
Check (c_getpeername (int (Socket), +c_address'Unchecked_Access,
c_address_len'Unchecked_Access));
if c_address_len /= struct_sockaddr_un'Size / char'Size then
raise Constraint_Error;
end if;
return (Socket_Address with C => c_address);
end Get_Peer_Name;
-----------------------
-- Get_Socket_Name --
-----------------------
function c_getsockname
(s : int; socketaddress : sockaddr_var_ptr;
addresslen : size_t_var_ptr) return int;
pragma Import (C, c_getsockname, getsockname_LINKNAME);
function Get_Socket_Name (Socket : POSIX.IO.File_Descriptor)
return Local_Socket_Address is
c_address : aliased struct_sockaddr_un;
c_address_len : aliased size_t := c_address'Size / char'Size;
begin
Check (c_getsockname (int (Socket), +c_address'Unchecked_Access,
c_address_len'Unchecked_Access));
if c_address_len /= struct_sockaddr_un'Size / char'Size then
raise Constraint_Error;
end if;
return (Socket_Address with C => c_address);
end Get_Socket_Name;
-----------------------
-- Get_Socket_Name --
-----------------------
function Get_Socket_Name (Handle : Socket_Message)
return Local_Socket_Address is
begin
-- cast the generic address pointer to a local socket
-- address pointer and dereference it. Note that dot1g uses
-- void* for these. Solaris uses typedef caddr_t which is char*.
return (Socket_Address with C => To_Ptr (Handle.C.msg_name).all);
end Get_Socket_Name;
-------------------
-- Get_Address --
-------------------
function Get_Address (Info_Item : Socket_Address_Information)
return Local_Socket_Address is
begin
-- cast the generic socket address pointer to a local socket
-- address pointer and dereference it
return (Socket_Address with C => To_Ptr (Info_Item.C.ai_addr).all);
end Get_Address;
end POSIX.Sockets.Local;