bbs_webif_0.1.0_3aacf510/src/bbs-web-files.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
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
--
--  Author: Brent Seidel
--  Date: 6-Aug-2024
--
--  This file is part of Simple Ada Web Server.
--  Simple Ada Web Server is free software: you can redistribute it and/or
--  modify it under the terms of the GNU General Public License as published
--  by the Free Software Foundation, either version 3 of the License, or (at
--  your option) any later version.
--
--  Simple Ada Web Server 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 along
--  with Simple Ada Web Server. If not, see <https://www.gnu.org/licenses/>.--
--
with Ada.Strings.Unbounded;
use type Ada.Strings.Unbounded.Unbounded_String;
with Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO;
with BBS.web.http;
package body BBS.web.files is

   --
   --  Send the contents of the specified binary type file out to the client
   --  program.  If the file can't be opened, a HTTP 404 NOT FOUND code is
   --  returned instead of 200 OK.
   --
   --  Note that currently the file is sent byte by byte.  This is likely not
   --  the most efficient way, but it works, and for now there is no need for
   --  maximum performance.
   --
   procedure send_binary_with_headers(s : GNAT.Sockets.Stream_Access;
                                    mime : String; name : String) is
      buff : Character;
      file : Char_IO.File_Type;
   begin
      begin
         Char_IO.Open(File => file,
                      Mode => Char_IO.In_File,
                      Name => name);
      exception
         when others =>
            BBS.web.http.internal_error(s, name);
            return;
      end;
      BBS.web.http.ok(s, mime);
      while not Char_IO.End_Of_File(file) loop
         Char_IO.Read(file, buff);
         Character'Write(s, buff);
      end loop;
      Char_IO.Close(file);
   end send_binary_with_headers;

   --
   --  Send the contents of the specified text type file out to the client
   --  program.  If the file can't be opened, a HTTP 404 NOT FOUND code is
   --  returned instead of 200 OK.
   --
   procedure send_text_with_headers(s : GNAT.Sockets.Stream_Access;
                                    mime : String; name : String) is
      line : Ada.Strings.Unbounded.Unbounded_String;
      file : Ada.Text_IO.File_Type;
   begin
      begin
         Ada.Text_IO.Open(File => file,
                          Mode => Ada.Text_IO.In_File,
                          Name => name);
      exception
         when others =>
            BBS.web.http.internal_error(s, name);
            return;
      end;
      BBS.web.http.ok(s, mime);
      while not Ada.Text_IO.End_Of_File(file) loop
         line := Ada.Text_IO.Unbounded_IO.Get_Line(file);
         String'Write(s, Ada.Strings.Unbounded.To_String(line) & CRLF);
      end loop;
      Ada.Text_IO.Close(file);
   end send_text_with_headers;
   --
   --  This procedure sends a text file to the client with headers.  If the file
   --  cannot be opened, the procedure simply returns.
   --
   procedure send_text_without_headers(s : GNAT.Sockets.Stream_Access;
                                    name : String) is
      line : Ada.Strings.Unbounded.Unbounded_String;
      file : Ada.Text_IO.File_Type;
   begin
      begin
         Ada.Text_IO.Open(File => file,
                          Mode => Ada.Text_IO.In_File,
                          Name => name);
      exception
         when others =>
            return;
      end;
      while not Ada.Text_IO.End_Of_File(file) loop
         line := Ada.Text_IO.Unbounded_IO.Get_Line(file);
         String'Write(s, Ada.Strings.Unbounded.To_String(line) & CRLF);
      end loop;
      Ada.Text_IO.Close(file);
   end send_text_without_headers;

end BBS.web.files;