From 9d912cdd8f2fc637a5876ca21a7ce5906e34e889 Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
Date: Thu, 14 Apr 2022 09:21:19 -0400
Subject: Crypt module working with bcrypt passwords correctly.

---
 captain/captain.f90            |  14 +++++-
 captain/crypt.f90              | 101 +++++++++++++++++++++++++++++++++++++++++
 captain/levitating-captain.prj |   6 ++-
 3 files changed, 119 insertions(+), 2 deletions(-)
 create mode 100644 captain/crypt.f90

diff --git a/captain/captain.f90 b/captain/captain.f90
index 76ea768..94b2f96 100644
--- a/captain/captain.f90
+++ b/captain/captain.f90
@@ -79,9 +79,10 @@ contains
     
     subroutine parse_options
     use config
+    use m_crypt
     implicit none
     
-        character(len=1024)::option
+        character(len=1024)::option, tmp
         logical::config_loaded
         integer::i
 
@@ -105,6 +106,17 @@ contains
                 call get_command_argument(i, option)
                 call load_configuration(trim(option))
                 config_loaded = .true.
+                
+            ! This option shouldn't be public, and it just verifies the
+            ! m_crypt module works...
+            else if(trim(option) == "--hash") then
+                i = i + 1
+                call get_command_argument(i, option)
+                tmp = hash(option)
+                Print *, "Hash: "//trim(tmp)
+                Print *, "Verify: "//trim(option), verify_hash(trim(option), tmp)
+                Print *, "Unverify: "//trim(option)//"X", verify_hash(trim(option)//"X", tmp)
+                stop
 
             end if
             
diff --git a/captain/crypt.f90 b/captain/crypt.f90
new file mode 100644
index 0000000..fc76fdb
--- /dev/null
+++ b/captain/crypt.f90
@@ -0,0 +1,101 @@
+module m_crypt
+implicit none
+
+    interface
+        function crypt_c(phrase, setting) bind(c, name="crypt")
+        use iso_c_binding
+        type(c_ptr), value::phrase
+        type(c_ptr), value::setting
+        type(c_ptr)::crypt_c
+        end function crypt_c
+        
+        function crypt_gensalt_c(prefix, count, rbytes, nrbytes) bind(c, name="crypt_gensalt")
+        use iso_c_binding
+        type(c_ptr), value::prefix
+        integer(kind=c_long), value::count
+        type(c_ptr), value::rbytes
+        integer(kind=c_int), value::nrbytes
+        type(c_ptr)::crypt_gensalt_c
+        end function crypt_gensalt_c
+    end interface
+
+contains
+
+    function hash(phrase)
+    use iso_c_binding
+    implicit none
+    
+        character(len=*), intent(in)::phrase
+        character(len=:), pointer::hash
+        
+        character(len=:,kind=c_char), pointer::c_phrase
+        type(c_ptr)::c_res_ptr, c_salt_ptr
+        character(kind=c_char), dimension(:), pointer::c_res
+        character(len=5, kind=c_char), target::prefix
+        integer::i
+        
+        interface
+            function strlen_c(cstr) bind(c, name="strlen")
+            use iso_c_binding
+            type(c_ptr), value::cstr
+            integer(kind=c_size_t)::strlen_c
+            end function strlen_c
+        end interface
+    
+        hash => null()
+        
+        ! Build the salt
+        prefix = "$2b$"//c_null_char
+        c_salt_ptr = crypt_gensalt_c(c_loc(prefix), 16, c_null_ptr, 0)
+        
+        allocate(character(len=len_trim(phrase)+1) :: c_phrase)
+        c_phrase = trim(phrase)//c_null_char
+
+        c_res_ptr = crypt_c(c_loc(c_phrase), c_salt_ptr)
+        if(c_associated(c_res_ptr)) then
+            call c_f_pointer(c_res_ptr, c_res, (/ strlen_c(c_res_ptr) /) )
+            allocate(character(len=strlen_c(c_res_ptr)) :: hash)
+            do i = 1, len(hash)
+                hash(i:i) = c_res(i)
+            end do
+        end if
+        
+        deallocate(c_phrase)
+        
+    end function hash
+    
+    function verify_hash(phrase, hashed)
+    use iso_c_binding
+    implicit none
+    
+        character(len=*), intent(in)::phrase, hashed
+        logical::verify_hash
+        
+        character(len=:,kind=c_char), pointer::c_phrase
+        character(len=:,kind=c_char), pointer::c_hash
+        
+        type(c_ptr)::rehashed
+        
+        interface
+            function strcmp_c(p1, p2) bind(c, name="strcmp")
+            use iso_c_binding
+            type(c_ptr), value::p1, p2
+            integer(kind=c_int)::strcmp_c
+            end function strcmp_c
+        end interface
+        
+        allocate(character(len=len_trim(phrase)+1)::c_phrase)
+        c_phrase = trim(phrase)//c_null_char
+        
+        allocate(character(len=len_trim(hashed)+1)::c_hash)
+        c_hash = trim(hashed)//c_null_char
+        
+        rehashed = crypt_c(c_loc(c_phrase), c_loc(c_hash))
+        verify_hash = (strcmp_c(rehashed, c_loc(c_hash)) == 0)
+        
+        deallocate(c_hash)
+        deallocate(c_phrase)
+    
+    end function verify_hash
+
+end module m_crypt
diff --git a/captain/levitating-captain.prj b/captain/levitating-captain.prj
index 066c943..a9a6e6e 100644
--- a/captain/levitating-captain.prj
+++ b/captain/levitating-captain.prj
@@ -89,6 +89,9 @@
       },{
         "filename":"config.f90",
         "enabled":"1"
+      },{
+        "filename":"crypt.f90",
+        "enabled":"1"
       },{
         "filename":"db.f90",
         "enabled":"1"
@@ -182,7 +185,8 @@
       "Build Before Launch":"true"
     },
     "Build Options":{
-      "Makefile":"Makefile",
+      "Auto Management":"true",
+      "Makefile":"Makefile.levitating-captain",
       "Auto Makefile":"true"
     },
     "Linker Options":{
-- 
cgit v1.2.3