encryption_utilities_20220701.0.0_1b883b94/src/password_line.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
-- Non-echoed input for obtaining passwords
-- Works with GNAT/Linux and Windows and ObjectAda/Windows
-- Copyright (C) 2022 by PragmAda Software Engineering
--
-- History:
-- 2022 Feb 15     J. Carter          V1.3--OA 10.3 does not need a workaround
-- 2021 May 15     J. Carter          V1.2--Mention OA workaround
-- 2021 Feb 01     J. Carter          V1.1--Improve backspace handling
-- 2017 Feb 01     J. Carter          V1.0--Initial release
--
with Ada.Characters.Latin_1;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

function Password_Line (Echo : Boolean := True) return String is
   LF  : Character renames Ada.Characters.Latin_1.LF;
   CR  : Character renames Ada.Characters.Latin_1.CR;
   DEL : Character renames Ada.Characters.Latin_1.DEL;
   BS  : Character renames Ada.Characters.Latin_1.BS;

   use Ada.Strings.Unbounded;

   Result : Unbounded_String;
   Ch     : Character;
begin -- Password_Line
   All_Characters : loop
      Ada.Text_IO.Get_Immediate (Item => Ch);

      case Ch is
      when LF | CR =>
         Ada.Text_IO.New_Line;

         return To_String (Result);
      when DEL | BS =>
         Delete (Source => Result, From => Length (Result), Through => Length (Result) );

         if Echo then
            Ada.Text_IO.Put (Item => BS & ' ' & BS);
         end if;
      when others =>
         Append (Source => Result, New_Item => Ch);

         if Echo then
            Ada.Text_IO.Put (Item => '*');
         end if;
      end case;
   end loop All_Characters;
end Password_Line;
--
-- 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 WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. 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.