--- /dev/null
+Alexander Ilin
--- /dev/null
+! Copyright (C) 2020 Alexander Ilin.
+! See http://factorcode.org/license.txt for BSD license.
+USING: destructors help.markup help.syntax kernel math sodium sodium.ffi
+quotations ;
+IN: sodium.secure-memory
+
+ABOUT: "sodium.secure-memory"
+
+ARTICLE: "sodium.secure-memory" "Secure memory"
+"The " { $vocab-link "sodium.secure-memory" } " vocab provides a simple wrapper around some of the libsodium's Secure memory functions, see " { $url "https://libsodium.gitbook.io/doc/memory_management" } "." $nl
+"The class for securely allocated alien memory:"
+{ $subsections secure-memory new-secure-memory }
+"Temporary memory access combinators:"
+{ $subsections with-read-access with-write-access }
+"Memory access restriction setters:"
+{ $subsections allow-no-access allow-read-access allow-write-access } ;
+
+HELP: secure-memory
+{ $class-description "The " { $link disposable } " class wrapping some secure memory allocated by libsodium. This class has two slots:"
+ { $list
+ { { $slot "underlying" } " - pointer to memory allocated by libsodium's " { $link sodium_malloc } ";" }
+ { { $slot "size" } " - memory block size in bytes." }
+ }
+ "New instances must be constructed with " { $link new-secure-memory } " or using " { $link clone } ". The cloned objects have an independent copy of a newly allocated secure memory block (deep copy), so read access to the source memory must be granted prior to cloning. The cloned memory doesn't inherit the current access right of the source, instead it starts with the same access rights which are normally granted by calling " { $link new-secure-memory } "." } ;
+
+HELP: new-secure-memory
+{ $values
+ { "size" integer }
+ { "obj" secure-memory }
+}
+{ $description "Allocates a new instance of " { $link secure-memory } " with " { $snippet "size" } " bytes of freshly allocated alien memory pointed by the " { $slot "underlying" } " slot. Follow the " { $link "destructors-using" } " protocol to release the memory." $nl
+ "In case the memory could not be allocated, " { $link sodium-malloc-error } " is thrown." $nl
+ "Initial memory contents are not zero, see documentation at " { $url "https://libsodium.gitbook.io/doc/memory_management" } ". The memory is initially in the read-write mode, but is protected against swapping out by the OS (if supported) and against out of boundary access. Call " { $link allow-no-access } " to restrict access after your own initialization." } ;
+
+HELP: allow-no-access
+{ $values
+ { "secure-memory" secure-memory }
+}
+{ $description "Disable both read and write access to the " { $snippet "secure-memory" } ". Any subsequent access to the memory will raise a memory protection exception." } ;
+
+HELP: allow-read-access
+{ $values
+ { "secure-memory" secure-memory }
+}
+{ $description "Allow read-only access to the " { $snippet "secure-memory" } ". Any subsequent write to the memory will raise a memory protection exception." } ;
+
+HELP: allow-write-access
+{ $values
+ { "secure-memory" secure-memory }
+}
+{ $description "Allow read and write access to the " { $snippet "secure-memory" } "." } ;
+
+HELP: with-read-access
+{ $values
+ { "secure-memory" secure-memory }
+ { "quot: ( secure-memory -- )" quotation }
+}
+{ $description "Temporarily allow read-only access to the " { $snippet "secure-memory" } " for the duration of the " { $snippet "quot" } " call. When the quotation terminates, disable the access using " { $link allow-no-access } "." } ;
+
+HELP: with-write-access
+{ $values
+ { "secure-memory" secure-memory }
+ { "quot: ( secure-memory -- )" quotation }
+}
+{ $description "Temporarily allow read and write access to the " { $snippet "secure-memory" } " for the duration of the " { $snippet "quot" } " call. When the quotation terminates, disable the access using " { $link allow-no-access } "." } ;
+
+{
+ allow-no-access allow-read-access allow-write-access
+ with-read-access with-write-access
+} related-words
+
+HELP: secure-memory=
+{ $values
+ { "a" secure-memory }
+ { "b" secure-memory }
+ { "?" boolean }
+}
+{ $description "Compare the memory contents of the two memory regions and return " { $link t } " on full match. Both regions must be allocated, have equal " { $slot "size" } ", and the read access to the memory should be allowed." }
+{ $notes "Comparison of secure memory blocks of equal size is performed in constant time using " { $link sodium_memcmp } "." } ;
--- /dev/null
+! Copyright (C) 2020 Alexander Ilin.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.data byte-arrays destructors kernel literals
+namespaces sequences sodium.ffi sodium.secure-memory tools.test ;
+IN: sodium.secure-memory.tests
+
+SYMBOLS: test-mem test-cloned ;
+
+: =uninit? ( secure-memory -- ? )
+ binary-object memory>byte-array
+ crypto_auth_hmacsha512_KEYBYTES 0xdb <repetition> >byte-array = ;
+
+{ $ crypto_auth_hmacsha512_KEYBYTES } [
+ crypto_auth_hmacsha512_KEYBYTES new-secure-memory dup test-mem set-global
+ size>>
+] unit-test
+
+{ t } [ test-mem get-global =uninit? ] unit-test
+[ test-mem get-global dup allow-no-access clone ] must-fail
+[ test-mem get-global >c-ptr crypto_auth_hmacsha512_keygen ] must-fail
+
+! Write a random key to test-mem.
+{ } [
+ test-mem get-global [
+ >c-ptr crypto_auth_hmacsha512_keygen
+ ] with-write-access
+] unit-test
+
+! Clone the test-mem into test-cloned.
+{ $ crypto_auth_hmacsha512_KEYBYTES } [
+ test-mem get-global [
+ clone dup test-cloned set-global size>>
+ ] with-read-access
+] unit-test
+
+[ test-mem get-global =uninit? ] must-fail
+{ f } [ test-cloned get-global =uninit? ] unit-test
+{ f } [ test-mem get-global [ =uninit? ] with-read-access ] unit-test
+
+! Contents of test-mem and test-cloned must match. test-cloned must have write
+! access after cloning.
+{ t } [
+ test-mem get-global [
+ test-cloned get-global secure-memory=
+ ] with-read-access
+] unit-test
+
+! Write a new random key to test-cloned. After that the contents of test-mem and
+! test-cloned must no longer match.
+{ f } [
+ test-cloned get-global dup >c-ptr crypto_auth_hmacsha512_keygen
+ test-mem get-global [ secure-memory= ] with-read-access
+] unit-test
+
+{ f f } [
+ test-cloned [ dup dispose [ size>> ] [ >c-ptr ] bi f ] change-global
+] unit-test
+
+[ test-mem [ dup dispose f ] change-global clone ]
+[ already-disposed? ] must-fail-with
--- /dev/null
+! Copyright (C) 2020 Alexander Ilin.
+! See http://factorcode.org/license.txt for BSD license.
+USING:
+ accessors alien combinators.short-circuit continuations destructors kernel
+ libc
+ sodium sodium.ffi
+;
+
+IN: sodium.secure-memory
+
+TUPLE: secure-memory < disposable
+ size underlying ;
+
+: new-secure-memory ( size -- obj )
+ dup sodium-malloc secure-memory new-disposable
+ swap >>underlying swap >>size ;
+
+: allow-no-access ( secure-memory -- )
+ check-disposed underlying>> sodium_mprotect_noaccess check0 ;
+
+: allow-read-access ( secure-memory -- )
+ check-disposed underlying>> sodium_mprotect_readonly check0 ;
+
+: with-read-access ( ..a secure-memory quot: ( ..a secure-memory -- ..b ) -- ..b )
+ over dup allow-read-access [ allow-no-access ] curry finally ; inline
+
+: allow-write-access ( secure-memory -- )
+ check-disposed underlying>> sodium_mprotect_readwrite check0 ;
+
+: with-write-access ( ..a secure-memory quot: ( ..a secure-memory -- ..b ) -- ..b )
+ over dup allow-write-access [ allow-no-access ] curry finally ; inline
+
+: with-new-secure-memory ( ..a size quot: ( ..a secure-memory -- ..b ) -- ..b secure-memory )
+ [ new-secure-memory ] dip with-write-access ; inline
+
+: secure-memory= ( a b -- ? )
+ [ check-disposed ] bi@ {
+ [ [ size>> ] bi@ = ]
+ [ [ [ >c-ptr ] bi@ ] keep size>> memory= ]
+ } 2&& ;
+
+M: secure-memory dispose* ( disposable -- )
+ [ sodium_free f ] change-underlying f swap size<< ;
+
+M: secure-memory byte-length ( obj -- n )
+ size>> ;
+
+M: secure-memory clone ( obj -- cloned )
+ check-disposed [
+ size>> new-secure-memory dup underlying>>
+ ] [ underlying>> ] [ size>> ] tri memcpy ;
--- /dev/null
+! Copyright (C) 2020 Alexander Ilin.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien help.markup help.syntax kernel sodium.ffi ;
+IN: sodium
+
+HELP: check-malloc
+{ $values
+ { "ptr" alien }
+ { "ptr/*" alien }
+}
+{ $description "Check if " { $snippet "ptr" } " is " { $snippet "null" } " and throw " { $link sodium-malloc-error } " in that case. Otherwise simply leave " { $snippet "ptr" } " as is." } ;
+
+HELP: sodium-malloc-error
+{ $description "Throws a " { $link sodium-malloc-error } " error." }
+{ $error-description "This error is thrown when " { $link sodium_malloc } " returns " { $snippet "null" } " due to memory allocation failure. Since each such allocation requires several pages of swap-protected memory, it is a limited resource in any OS." } ;
: check0 ( n -- ) 0 = [ call-fail ] unless ;
+ERROR: sodium-malloc-error ;
+
+: check-malloc ( ptr -- ptr/* )
+ dup [ sodium-malloc-error ] unless ;
+
+: sodium-malloc ( size -- ptr )
+ sodium_malloc check-malloc ;
+
: crypto-pwhash-str ( password opslimit memlimit -- str )
[ crypto_pwhash_strbytes <byte-array> dup ] 3dip
[ utf8 encode dup length ] 2dip crypto_pwhash_str check0
projects / factor.git / commitdiff