dummyserver_1.0.0_9a6e8708/src/black/Single_Thread_Server.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
with
  Ada.IO_Exceptions;
with
  GNAT.Sockets;
with
  Black.Request,
  Black.Response,
  GNAT.Sockets.Convenience;

procedure Single_Thread_Server is
   use GNAT.Sockets;
   Listener : Socket_Type;
begin
   Listener := Convenience.Make_Server (Port => 8080);

   loop
      declare
         Connection : Socket_Type;
         Client     : Sock_Addr_Type;
      begin
         Accept_Socket (Server  => Listener,
                        Socket  => Connection,
                        Address => Client);

         declare
            Request : constant Black.Request.Instance :=
                        Black.Request.Parse_HTTP (Stream (Connection));
            use Black.Response;
         begin
            if Request.Resource = "/redirect" then
               pragma Warnings (Off); --  Workaround for GNAT-4.6.
               Instance'Output
                 (Stream (Connection),
                  Redirect (Target    => "http://www.jacob-sparre.dk/",
                            Permanent => False));
               pragma Warnings (On); --  Workaround for GNAT-4.6.
            elsif Request.Resource = "/" then
               pragma Warnings (Off); --  Workaround for GNAT-4.6.
               Instance'Output
                 (Stream (Connection),
                  OK (Data => "You've visited the single threaded Black " &
                              "example server."));
               pragma Warnings (On); --  Workaround for GNAT-4.6.
            elsif Request.Resource = "/stop" then
               pragma Warnings (Off); --  Workaround for GNAT-4.6.
               Instance'Output
                 (Stream (Connection),
                  OK (Data => "You've visited the single threaded Black " &
                              "example server.  Stopping..."));
               pragma Warnings (On); --  Workaround for GNAT-4.6.
               exit;
            else
               pragma Warnings (Off); --  Workaround for GNAT-4.6.
               Instance'Output (Stream (Connection),
                                Not_Found (Resource => Request.Resource));
               pragma Warnings (On); --  Workaround for GNAT-4.6.
            end if;
         end;

         Close_Socket (Socket => Connection);
      exception
         when Ada.IO_Exceptions.End_Error =>
            null;
      end;
   end loop;
end Single_Thread_Server;