Making a keychain in Mathematica

Question

How can I build a password keychain in Mathematica? I have a number of different accounts that I use programmatically and it's annoying to have to put in my login info each time.

Answer 1

This is a long-ish answer with very little core code. I stuck all of it in a block at the end

So to keep this applicable to before v11.1 we'll use Encode over EncryptFile (note that Encrypt would work fine here, if we simply access then re-encrypt a password expression at each usage).

First we'll choose a location and name for our encoded file:

$keychainDir = FileNameJoin@{$TemporaryDirectory, "keychain"};
CreateDirectory@$keychainDir;
$keychainName = "KeyChain";

Then we'll make an export function to this keychain with a specified password. Basically what we'll do is export to a plain .m then apply Encode with the given password.

keychainExport[expr_, pass_String] :=
  Encode[
   Export[FileNameJoin@{$keychainDir, $keychainName <> ".m"}, expr],
   FileNameJoin@{$keychainDir, $keychainName <> ".mx"},
   pass
   ];

Then we'll simply build an Association of {site,username}->password incrementally. First we'll export an empty Association, given a password for it.

$keychainPassword = "password";
keychainExport[expr_, Optional[Automatic, Automatic]] :=

  keychainExport[expr, $keychainPassword];

keychainExport[<||>]

And then we can write an add function and a lookup function

keychainAdd[{site_, username_}, password_] :=
  keychainExport[
   Append[Get[
     FileNameJoin@{$keychainDir, $keychainName <> 
        ".mx"}, $keychainPassword], {site, username} -> password
    ]
   ];
keychainGet[{site_, username_}] := 
 Lookup[Get[
   FileNameJoin@{$keychainDir, $keychainName <> ".mx"}, $keychainPassword], 
  Key@{site, username}]

Better yet, if we have a password dialog function we can then write keychainGet to automatically ask for and save a password:

keychainGet[{site_, username_}] := 
 Lookup[Get[
   FileNameJoin@{$keychainDir, $keychainName <> ".mx"}, $keychainPassword], 
  Key@{site, username},
  With[{authInfo = AuthenticationDialog[{{site, Automatic}, username}]},
   If[authInfo =!= $Canceled,
    keychainAdd[{site, username}, Last@authInfo[site]];
    Last@authInfo[site],
    authInfo
    ]
   ]
  ]

And then testing this out:

In[17]:= keychainGet[{$CloudBase, "me@me.me"}]

Out[17]:= "password"

(note that future lookups will not cause the dialog to open)

Then we can write a function that will cloud connect with credentials:

In[21]:= keychainCloudConnect[acct_String] :=

  CloudConnect[acct, keychainGet[{$CloudBase, acct}]];
keychainCloudConnect[{base_, acct_String}] :=

  CloudConnect[acct, keychainGet[{base, acct}], CloudBase -> base];

And I can use this to swap between accounts without ever having to re-enter my passwords.

Of course, if I change those passwords I'll want to remove the credentials:

keychainRemove[{site_, username_} ] :=
  keychainExport[
   KeyDrop[
    Get[FileNameJoin@{$keychainDir, $keychainName <> 
        ".mx"}, $keychainPassword], {{site, username}}
    ]
   ];

And happily the passwords are pretty much scrambled:

In[41]:= text = 
 Import[FileNameJoin@{$keychainDir, $keychainName <> ".mx"}, "Text"]

Out[41]= "(*!1N!*)>z¥
1gK£dD©3AVJ6_vy9>*|-9zW^}Ys3*iPea*Y(wD.T4G^\\!gUt6\\V5%b \
14HEwTI| CYO*i]
&!d$lM6^Od7_sS;$P\"y!-nB~MsV!djmq Ac*;kh¦#=Y^_kB<#N"

Although if someone knows your password they can recover the data:

In[48]:= file = (DeleteFile[#]; CreateFile[# <> ".mx"]) &@CreateFile[];
Get[Export[file, text, "String"], $keychainPassword]

Out[49]= <|{"https://www.wolframcloud.com/", "me@me.me"} -> 
  "password"|>

---

Code Block:

$keychainDir = FileNameJoin@{$TemporaryDirectory, "keychain"};
CreateDirectory@$keychainDir;
$keychainName = "KeyChain";

keychainExport[expr_, pass_String] :=
  Encode[
   Export[FileNameJoin@{$keychainDir, $keychainName <> ".m"}, expr],
   FileNameJoin@{$keychainDir, $keychainName <> ".mx"},
   pass
   ];

$keychainPassword = "password";
keychainExport[expr_, Optional[Automatic, Automatic]] :=

  keychainExport[expr, $keychainPassword];

keychainExport[<||>]

keychainAdd[{site_, username_}, password_] :=
  keychainExport[
   Append[
    Get[FileNameJoin@{$keychainDir, $keychainName <> 
        ".mx"}, $keychainPassword], {site, username} -> password
    ]
   ];
keychainGet[{site_, username_}] := 
  Lookup[Get[
    FileNameJoin@{$keychainDir, $keychainName <> 
       ".mx"}, $keychainPassword], Key@{site, username}];

(*keychainGet[{site_, username_}] := 
 Lookup[Get[
   FileNameJoin@{$keychainDir, $keychainName <> 
      ".mx"}, $keychainPassword], Key@{site, username},
  With[{authInfo = 
     AuthenticationDialog[{{site, Automatic}, username}]},
   If[authInfo =!= $Canceled,
    keychainAdd[{site, username}, Last@authInfo[site]];
    Last@authInfo[site],
    authInfo
    ]
   ]
  ]*)

keychainRemove[{site_, username_}] :=
  keychainExport[
   KeyDrop[
    Get[FileNameJoin@{$keychainDir, $keychainName <> 
        ".mx"}, $keychainPassword], {{site, username}}
    ]
   ];

keychainCloudConnect[acct_String] :=

  CloudConnect[acct, keychainGet[{$CloudBase, acct}]];
keychainCloudConnect[{base_, acct_String}] :=

  CloudConnect[acct, keychainGet[{base, acct}], CloudBase -> base];