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

4.104.114.84.95
Last change on this file since 1d4048b2 was 1d4048b2, checked in by Joel Sherrill <joel.sherrill@…>, on 08/11/99 at 23:45:57

Patch from Tony R. Ambardar <tonya@…>:

I'm attaching a big patch for the ts_386ex BSP which adds and includes
the following:

1) Conversion to ELF format + minor code cleanups + documentation.

2) An Ada95 binding to FreeBSD sockets, based on Samuel Tardieu's

adasockets-0.1.3 package. This includes some sample applications.

3) Some Ada and C interfaces to add serial-port debugging to

programs. Comes with examples, too; the Ada one shows how
transparent adding the support can be. Note that Rosimildo sent me
the original C code.

The network stuff is not BSP specific, and could be added to your Ada
code collection. The debugging stuff is specific to the i386. Right
now, everything sits in my "tools" directory.
  • 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.