source: rtems/c/src/lib/libbsp/i386/ts_386ex/tools/network_ada/adasockets/sockets-multicast.adb @ d333638

Last change on this file since d333638 was d333638, checked in by Ralf Corsepius <ralf.corsepius@…>, on Oct 15, 2006 at 5:55:34 AM

Convert to utf-8.

  • Property mode set to 100644
File size: 5.6 KB
Line 
1-----------------------------------------------------------------------------
2--                                                                         --
3--                         ADASOCKETS COMPONENTS                           --
4--                                                                         --
5--                   S O C K E T S . M U L T I C A S T                     --
6--                                                                         --
7--                                B o d y                                  --
8--                                                                         --
9--                        $ReleaseVersion: 0.1.3 $                         --
10--                                                                         --
11--  Copyright (C) 1998  École Nationale Supérieure des Télécommunications  --
12--                                                                         --
13--   AdaSockets is free software; you can  redistribute it and/or modify   --
14--   it  under terms of the GNU  General  Public License as published by   --
15--   the Free Software Foundation; either version 2, or (at your option)   --
16--   any later version.   AdaSockets is distributed  in the hope that it   --
17--   will be useful, but WITHOUT ANY  WARRANTY; without even the implied   --
18--   warranty of MERCHANTABILITY   or FITNESS FOR  A PARTICULAR PURPOSE.   --
19--   See the GNU General Public  License  for more details.  You  should   --
20--   have received a copy of the  GNU General Public License distributed   --
21--   with AdaSockets; see   file COPYING.  If  not,  write  to  the Free   --
22--   Software  Foundation, 59   Temple Place -   Suite  330,  Boston, MA   --
23--   02111-1307, USA.                                                      --
24--                                                                         --
25--   As a special exception, if  other  files instantiate generics  from   --
26--   this unit, or  you link this  unit with other  files to produce  an   --
27--   executable,  this  unit does  not  by  itself cause  the  resulting   --
28--   executable to be  covered by the  GNU General Public License.  This   --
29--   exception does  not  however invalidate any  other reasons  why the   --
30--   executable file might be covered by the GNU Public License.           --
31--                                                                         --
32--   The main repository for this software is located at:                  --
33--       http://www-inf.enst.fr/ANC/                                       --
34--                                                                         --
35-----------------------------------------------------------------------------
36
37with Ada.Exceptions;    use Ada.Exceptions;
38with Interfaces.C;      use Interfaces.C;
39with Sockets.Constants; use Sockets.Constants;
40with Sockets.Naming;    use Sockets.Naming;
41with Sockets.Thin;      use Sockets.Thin;
42with Sockets.Utils;     use Sockets.Utils;
43
44package body Sockets.Multicast is
45
46   use Ada.Streams;
47
48   procedure Setsockopt_Add_Membership is
49      new Customized_Setsockopt (IPPROTO_IP, IP_ADD_MEMBERSHIP, Ip_Mreq);
50
51   -----------------------------
52   -- Create_Multicast_Socket --
53   -----------------------------
54
55   function Create_Multicast_Socket
56     (Group     : String;
57      Port      : Positive;
58      TTL       : Positive := 16;
59      Self_Loop : Boolean  := True)
60     return Multicast_Socket_FD
61   is
62      Result      : Multicast_Socket_FD;
63      Mreq        : aliased Ip_Mreq;
64      C_Self_Loop : Integer;
65   begin
66      Socket (Socket_FD (Result), AF_INET, SOCK_DGRAM);
67      if Self_Loop then
68         C_Self_Loop := 1;
69      else
70         C_Self_Loop := 0;
71      end if;
72      Setsockopt (Result, SOL_SOCKET, SO_REUSEADDR, 1);
73      Bind (Result, Port);
74      Mreq.Imr_Multiaddr := To_In_Addr (Address_Of (Group));
75      Setsockopt_Add_Membership (Result, Mreq);
76      Setsockopt (Result, IPPROTO_IP, IP_MULTICAST_TTL, TTL);
77      Setsockopt (Result, IPPROTO_IP, IP_MULTICAST_LOOP, C_Self_Loop);
78      Result.Target := (Result.Target'Size / 8,
79                        Constants.Af_Inet,
80                        Port_To_Network (unsigned_short (Port)),
81                        To_In_Addr (Address_Of (Group)),
82                        (others => char'Val (0)));
83      return Result;
84   end Create_Multicast_Socket;
85
86   ----------
87   -- Send --
88   ----------
89
90   procedure Send (Socket : in Multicast_Socket_FD;
91                   Data   : in Stream_Element_Array)
92   is
93      Sin   : aliased Sockaddr_In   := Socket.Target;
94      Index : Stream_Element_Offset := Data'First;
95      Rest  : Stream_Element_Count  := Data'Length;
96      Count : int;
97   begin
98      while Rest > 0 loop
99         Count := C_Sendto (Socket.FD,
100                            Data (Index) 'Address,
101                            int (Rest),
102                            0,
103                            Sin'Address,
104                            Sin'Size / 8);
105         if Count < 0 then
106            Raise_With_Message ("Send failed");
107         elsif Count = 0 then
108            raise Connection_Closed;
109         end if;
110         Index := Index + Stream_Element_Count (Count);
111         Rest  := Rest - Stream_Element_Count (Count);
112      end loop;
113   end Send;
114
115   ------------
116   -- Socket --
117   ------------
118
119   procedure Socket
120     (Sock   : out Multicast_Socket_FD;
121      Domain : in Socket_Domain := AF_INET;
122      Typ    : in Socket_Type   := SOCK_STREAM)
123   is
124   begin
125      Raise_Exception (Program_Error'Identity,
126                       "Use Create_Multicast_Socket instead");
127      Sock := Sock; -- To keep the compiler happy
128   end Socket;
129
130end Sockets.Multicast;
Note: See TracBrowser for help on using the repository browser.