Natools

Check-in [9b0bfa42ad]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:hmac-pinentry: new POSIX-only package to retrieve HMAC key using pinentry protocol
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 9b0bfa42ad9e548daf6af480a2b50030c393fc98
User & Date: nat on 2014-07-03 18:05:17
Other Links: manifest | tags
Context
2014-07-09
17:52
Update LICENSE and add README check-in: 41ff0e3319 user: nat tags: trunk
2014-07-03
18:05
hmac-pinentry: new POSIX-only package to retrieve HMAC key using pinentry protocol check-in: 9b0bfa42ad user: nat tags: trunk
2014-06-21
19:52
s_expressions-encodings: replace assert-in-loop by asserting a slice comparison check-in: 6fad53c7fc user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified tools/hmac-main.adb from [bb4eabd511] to [35a84dc5b3].

︙
11
12
13
14
15
16
17

18
19
20
21
22
23
24
25
26


27
28
29
30
31
32
33

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








+









+
+








-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Text_IO.Text_Streams;

with Natools.Getopt_Long;
with Natools.S_Expressions;
with Natools.S_Expressions.Encodings;
with Natools.S_Expressions.File_Readers;

with HMAC.Pinentry;

procedure HMAC.Main is

   procedure Base64_Output (Digest : in Ada.Streams.Stream_Element_Array);
      --  Output the given binary Digest in base-64

   procedure Lower_Hex_Output (Digest : in Ada.Streams.Stream_Element_Array);
︙
41
42
43
44
45
46
47

48
49
50
51
52
53
54

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58








+










   package Options is
      type Id is
        (Base64_Output,
         Key_File,
         Lower_Hex_Output,
         Pinentry,
         Raw_Output,
         Upper_Hex_Output);
   end Options;

   package Getopt is new Natools.Getopt_Long (Options.Id);

   type Encode_Output is not null access procedure
︙
88
89
90
91
92
93
94













95
96
97
98
99
100
101

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118








+
+
+
+
+
+
+
+
+
+
+
+
+








                 (Natools.S_Expressions.To_String
                    (Natools.S_Expressions.File_Readers.Reader
                       (Argument).Read));
            end if;
            Handler.Has_Key := True;
         when Options.Lower_Hex_Output =>
            Handler.Output := Lower_Hex_Output'Access;
         when Options.Pinentry =>
            begin
               Handler.Key := Ada.Strings.Unbounded.To_Unbounded_String
                 (Pinentry.Get_Key (Argument));
               Handler.Has_Key := True;
            exception
               when Ex : others =>
                  Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error,
                     "Unable to get PIN from """ & Argument & '"');
                  Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error,
                     "exception " & Ada.Exceptions.Exception_Name (Ex)
                     & ": " & Ada.Exceptions.Exception_Message (Ex));
            end;
         when Options.Raw_Output =>
            Handler.Output := Raw_Output'Access;
         when Options.Upper_Hex_Output =>
            Handler.Output := Upper_Hex_Output'Access;
      end case;
   end Option;
︙
151
152
153
154
155
156
157





158
159
160
161
162


163
164










165
166
167
168
169
170
171

168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

184
185
186

187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203








+
+
+
+
+




-
+
+

-
+
+
+
+
+
+
+
+
+
+








     ("key-file", 'f', Getopt.Required_Argument, Options.Key_File);
   Opt_Config.Add_Option
     ("lower-hex", 'h', Getopt.No_Argument, Options.Lower_Hex_Output);
   Opt_Config.Add_Option
     ("raw", 'r', Getopt.No_Argument, Options.Raw_Output);
   Opt_Config.Add_Option
     ("upper-hex", 'H', Getopt.No_Argument, Options.Upper_Hex_Output);

   if Pinentry.Is_Available then
      Opt_Config.Add_Option
        ("pinentry", 'p', Getopt.Required_Argument, Options.Pinentry);
   end if;

   Opt_Config.Process (Handler);

   if not Handler.Has_Key then
      Ada.Text_IO.Put_Line ("Usage: "
      Ada.Text_IO.Put_Line ("Usage:");
      Ada.Text_IO.Put_Line ("   "
        & Ada.Command_Line.Command_Name
        & "[-h | -H | -b | -r] key [message]");
        & " [-h | -H | -b | -r] key [message]");
      Ada.Text_IO.Put_Line ("   "
        & Ada.Command_Line.Command_Name
        & " [-h | -H | -b | -r] -f path/to/key/file [message]");

      if Pinentry.Is_Available then
         Ada.Text_IO.Put_Line ("   "
           & Ada.Command_Line.Command_Name
           & " [-h | -H | -b | -r] -p path/to/bin/pinentry [message]");
      end if;

   elsif not Handler.Done then
      declare
         Context : HMAC_Implementation.Context
           := HMAC_Implementation.Create
              (Ada.Strings.Unbounded.To_String (Handler.Key));
         Block : Ada.Streams.Stream_Element_Array (1 .. 64);
︙

Added tools/hmac-pinentry.adb version [9c3ed75468]. 








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- This is the default empty (but portable) non-working implementation of   --
-- HMAC.Pinentry.                                                           --
------------------------------------------------------------------------------


package body HMAC.Pinentry is

   function Get_Key (Command : String) return String is
   begin
      raise Backend_Error
        with "HMAC.Pinentry is not implemented on this platform.";
      return "";
   end Get_Key;


   function Is_Available return Boolean is
   begin
      return False;
   end Is_Available;

end HMAC.Pinentry;








Added tools/hmac-pinentry.ads version [ed48822b66].








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- HMAC.Pinentry encapsulates communication with `pinentry` utility from    --
-- GnuPG project.                                                           --
-- Depending on communication features available, the package might not be  --
-- functional on all targets. A client should use Is_Available function to  --
-- ensure the underlying implentation is indeed operational.                --
------------------------------------------------------------------------------

package HMAC.Pinentry is

   Backend_Error : exception;

   function Get_Key (Command : String) return String;
      --  Run the given Command and communicate with it using pinentry protocol
      --  and return a secret String or raise Backend_Error.

   function Is_Available return Boolean;
      --  Check whether Get_Key can actually work

end HMAC.Pinentry;








Added tools/hmac-pinentry__posix.adb version [c4720e5fcf].

















































































































































































































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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Environment_Variables;
with Ada.Streams;

with POSIX.IO;
with POSIX.Process_Identification;
with POSIX.Process_Primitives;

with Natools.S_Expressions;

package body HMAC.Pinentry is

   procedure Check_OK (Fd : POSIX.IO.File_Descriptor);
      --  Check that pinentry OK response is coming through Fd

   procedure Check_OK
     (Receive, Send : in POSIX.IO.File_Descriptor;
      Command : in String);
      --  Send Command and wait for OK response

   function Read_Line (Fd : POSIX.IO.File_Descriptor) return String;
      --  Read a single line from Fd, aussming it will be smaller than 1 kb

   procedure Send_Command
     (Send : in POSIX.IO.File_Descriptor;
      Command : in String);
      --  Send Command through the given file descriptor



   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Check_OK (Fd : POSIX.IO.File_Descriptor) is
      Line : constant String := Read_Line (Fd);
   begin
      if Line'Length < 2
        or else Line (Line'First .. Line'First + 1) /= "OK"
      then
         raise Backend_Error with "Not-OK response """ & Line & '"';
      end if;
   end Check_OK;


   procedure Check_OK
     (Receive, Send : in POSIX.IO.File_Descriptor;
      Command : in String) is
   begin
      Send_Command (Send, Command);
      Check_OK (Receive);
   end Check_OK;


   function Read_Line (Fd : POSIX.IO.File_Descriptor) return String is
      Buffer : Ada.Streams.Stream_Element_Array (1 .. 1024);
      Next : Ada.Streams.Stream_Element_Offset := Buffer'First;
      Result : Ada.Streams.Stream_Element_Offset;

      use type Ada.Streams.Stream_Element;
      use type Ada.Streams.Stream_Element_Offset;
   begin
      loop
         POSIX.IO.Read (Fd, Buffer (Next .. Next), Result);
         exit when Result /= Next or else Buffer (Next) = 10;
         Next := Next + 1;
      end loop;

      return Natools.S_Expressions.To_String
        (Buffer (Buffer'First .. Next - 1));
   end Read_Line;


   procedure Send_Command
     (Send : in POSIX.IO.File_Descriptor;
      Command : in String)
   is
      Last : Ada.Streams.Stream_Element_Offset;
   begin
      if Command'Length > 0 then
         POSIX.IO.Write
           (Send,
            Natools.S_Expressions.To_Atom (Command & Character'Val (10)),
            Last);
      end if;
   end Send_Command;



   ----------------------
   -- Public Interface --
   ----------------------

   function Get_Key (Command : String) return String is
      Local_Send, Local_Receive : POSIX.IO.File_Descriptor;
      Remote_Send, Remote_Receive : POSIX.IO.File_Descriptor;
      Template : POSIX.Process_Primitives.Process_Template;
      Pid : POSIX.Process_Identification.Process_ID;
      Args : POSIX.POSIX_String_List;
   begin
      POSIX.Append (Args, POSIX.To_POSIX_String (Command));
      if Ada.Environment_Variables.Exists ("DISPLAY") then
         POSIX.Append (Args, POSIX.To_POSIX_String (String'("--display")));
         POSIX.Append (Args, POSIX.To_POSIX_String
           (Ada.Environment_Variables.Value ("DISPLAY")));
      end if;

      POSIX.IO.Create_Pipe (Local_Receive, Remote_Send);
      POSIX.IO.Create_Pipe (Remote_Receive, Local_Send);

      POSIX.Process_Primitives.Open_Template (Template);
      POSIX.Process_Primitives.Set_File_Action_To_Duplicate
        (Template => Template,
         File => POSIX.IO.Standard_Input,
         From_File => Remote_Receive);
      POSIX.Process_Primitives.Set_File_Action_To_Duplicate
        (Template => Template,
         File => POSIX.IO.Standard_Output,
         From_File => Remote_Send);
      POSIX.Process_Primitives.Set_File_Action_To_Close
        (Template, Local_Send);
      POSIX.Process_Primitives.Set_File_Action_To_Close
        (Template, Local_Receive);


      POSIX.Process_Primitives.Start_Process_Search
        (Pid,
         POSIX.Value (Args, 1),
         Template,
         Args);
      POSIX.Process_Primitives.Close_Template (Template);
      POSIX.Make_Empty (Args);

      Check_OK (Local_Receive);

      if POSIX.IO.Is_A_Terminal (POSIX.IO.Standard_Input) then
         Check_OK (Local_Receive, Local_Send, "OPTION ttyname="
            & POSIX.To_String
              (POSIX.IO.Get_Terminal_Name (POSIX.IO.Standard_Input)));
      end if;

      if Ada.Environment_Variables.Exists ("TERM") then
         Check_OK (Local_Receive, Local_Send,
            "OPTION ttytype=" & Ada.Environment_Variables.Value ("TERM"));
      end if;

      if Ada.Environment_Variables.Exists ("LC_CTYPE") then
         Check_OK (Local_Receive, Local_Send,
            "OPTION lc-ctype=" & Ada.Environment_Variables.Value ("LC_CTYPE"));
      end if;

      Send_Command (Local_Send, "GETPIN");
      declare
         Response : constant String := Read_Line (Local_Receive);
      begin

         if Response'Length < 2
           or else Response (Response'First .. Response'First + 1) /= "D "
         then
            raise Backend_Error with "Unexpected response to GETPIN: """
              & Response & '"';
         end if;

         Check_OK (Local_Receive);

         POSIX.IO.Close (Local_Send);
         POSIX.IO.Close (Local_Receive);
         POSIX.IO.Close (Remote_Send);
         POSIX.IO.Close (Remote_Receive);

         return Response (Response'First + 2 .. Response'Last);
      end;
   exception
      when others =>
         POSIX.Process_Primitives.Close_Template (Template);
         POSIX.Make_Empty (Args);
         POSIX.IO.Close (Local_Send);
         POSIX.IO.Close (Local_Receive);
         POSIX.IO.Close (Remote_Send);
         POSIX.IO.Close (Remote_Receive);
         raise;
   end Get_Key;


   function Is_Available return Boolean is
   begin
      return True;
   end Is_Available;

end HMAC.Pinentry;








Added unix_tools.gpr version [c708e673a3].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

with "natools";
with "florist";

project Unix_Tools is
   for Source_Dirs use ("tools");
   for Main use ("hmac-md5.ads", "hmac-sha1.ads", "hmac-sha256");

   for Object_Dir use Natools'Object_Dir;
   for Exec_Dir use Natools'Exec_Dir;

   package Compiler is
      for Default_Switches use Natools.Compiler'Default_Switches;
   end Compiler;

   package Linker is
      for Default_Switches use Natools.Linker'Default_Switches;
   end Linker;

   package Naming is
      for Body ("HMAC.Pinentry") use "hmac-pinentry__posix.adb";
   end Naming;
end Unix_Tools;













This page was generated in about
0.004s by
Fossil 2.23 [47362306a7] 2023-11-01 18:56:47