steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-04-10 22:02:36 -05:00
parent 039c344e87 2cefe124d6
commit 8c366cf746
8 changed files with 210 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
extra/crypto/test/blum-blum-shub.factor
View File

@ -1,5 +0,0 @@
USING: kernel math test namespaces crypto crypto-internals ;
[ 6 ] [ 5 T{ bbs f 590695557939 811977232793 } random-bbs-bits* ] unit-test
[ 792723710536787233474130382522 ] [ 100 T{ bbs f 200352954495 846054538649 } [ random-bbs-bits* drop ] 2keep random-bbs-bits* ] unit-test

20
extra/db/mysql/lib/lib.factor
View File

@ -18,16 +18,16 @@ TUPLE: mysql-result-set ;
: mysql-error ( mysql -- )
[ mysql_error throw ] when* ;
: mysql-connect ( mysql-connection -- )
new-mysql over set-mysql-db-handle
dup {
mysql-db-handle
mysql-db-host
mysql-db-user
mysql-db-password
mysql-db-db
mysql-db-port
} get-slots f 0 mysql_real_connect mysql-error ;
! : mysql-connect ( mysql-connection -- )
! new-mysql over set-mysql-db-handle
! dup {
! mysql-db-handle
! mysql-db-host
! mysql-db-user
! mysql-db-password
! mysql-db-db
! mysql-db-port
! } get-slots f 0 mysql_real_connect mysql-error ;
! =========================================================
! Low level mysql utility definitions

2
extra/opengl/gl/extensions/extensions.factor
View File

@ -1,6 +1,7 @@
USING: alien alien.syntax combinators kernel parser sequences
system words namespaces hashtables init math arrays assocs
continuations ;
IN: opengl.gl.extensions
ERROR: unknown-gl-platform ;
<< {
@ -9,7 +10,6 @@ ERROR: unknown-gl-platform ;
{ [ os unix? ] [ "opengl.gl.unix" ] }
{ [ t ] [ unknown-gl-platform ] }
} cond use+ >>
IN: opengl.gl.extensions
SYMBOL: +gl-function-number-counter+
SYMBOL: +gl-function-pointers+

28
extra/random/blum-blum-shub/blum-blum-shub-tests.factor Normal file
View File

@ -0,0 +1,28 @@
USING: kernel math tools.test namespaces random
random.blum-blum-shub ;
IN: blum-blum-shub.tests
[ 887708070 ] [
T{ blum-blum-shub f 590695557939 811977232793 } random-32*
] unit-test
[ 887708070 ] [
T{ blum-blum-shub f 590695557939 811977232793 } [
32 random-bits
] with-random
] unit-test
[ 5726770047455156646 ] [
T{ blum-blum-shub f 590695557939 811977232793 } [
64 random-bits
] with-random
] unit-test
[ 3716213681 ]
[
100 T{ blum-blum-shub f 200352954495 846054538649 } tuck [
random-32* drop
] curry times
random-32*
] unit-test

24
extra/random/blum-blum-shub/blum-blum-shub.factor
View File

@ -3,34 +3,26 @@ math.miller-rabin combinators.lib
math.functions accessors random ;
IN: random.blum-blum-shub
! TODO: take (log log M) bits instead of 1 bit
! Blum Blum Shub, M = pq
! Blum Blum Shub, n = pq, x_i+1 = x_i ^ 2 mod n
! return low bit of x+1
TUPLE: blum-blum-shub x n ;
C: <blum-blum-shub> blum-blum-shub
<PRIVATE
: generate-bbs-primes ( numbits -- p q )
#! two primes congruent to 3 (mod 4)
[ [ random-prime ] curry [ 4 mod 3 = ] generate ] dup bi ;
IN: crypto
: <blum-blum-shub> ( numbits -- blum-blum-shub )
#! returns a Blum-Blum-Shub tuple
generate-bbs-primes *
[ find-relative-prime ] keep
blum-blum-shub construct-boa ;
! 256 make-bbs blum-blum-shub set-global
: next-bbs-bit ( bbs -- bit )
#! x = x^2 mod n, return low bit of calculated x
[ [ x>> 2 ] [ n>> ] bi ^mod ]
[ [ >>x ] keep x>> 1 bitand ] bi ;
[ [ x>> 2 ] [ n>> ] bi ^mod ] keep
over >>x drop 1 bitand ;
IN: crypto
! : random ( n -- n )
! ! #! Cryptographically secure random number using Blum-Blum-Shub 256
! [ log2 1+ random-bits ] keep dupd >= [ -1 shift ] when ;
PRIVATE>
M: blum-blum-shub random-32* ( bbs -- r )
;
0 32 rot
[ next-bbs-bit swap 1 shift bitor ] curry times ;

14
extra/ui/windows/windows.factor
View File

@ -7,7 +7,7 @@ vectors words windows.kernel32 windows.gdi32 windows.user32
windows.opengl32 windows.messages windows.types windows.nt
windows threads libc combinators continuations command-line
shuffle opengl ui.render unicode.case ascii math.bitfields
locals symbols ;
locals symbols accessors ;
IN: ui.windows
SINGLETON: windows-ui-backend
@ -203,8 +203,18 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
wParam keystroke>gesture <key-up>
hWnd window-focus send-gesture drop ;
: set-window-active ( hwnd uMsg wParam lParam ? -- n )
>r 4dup r> 2nip nip
swap window set-world-active? DefWindowProc ;
: handle-wm-syscommand ( hWnd uMsg wParam lParam -- n )
dup alpha? [ 4drop 0 ] [ DefWindowProc ] if ;
{
{ [ over SC_MINIMIZE = ] [ f set-window-active ] }
{ [ over SC_RESTORE = ] [ t set-window-active ] }
{ [ over SC_MAXIMIZE = ] [ t set-window-active ] }
{ [ dup alpha? ] [ 4drop 0 ] }
{ [ t ] [ DefWindowProc ] }
} cond ;
: cleanup-window ( handle -- )
dup win-title [ free ] when*

195
extra/windows/advapi32/advapi32.factor
View File

@ -61,6 +61,133 @@ LIBRARY: advapi32
: CRYPT_MACHINE_KEYSET HEX: 20 ; inline
: CRYPT_SILENT HEX: 40 ; inline
C-STRUCT: ACL
{ "BYTE" "AclRevision" }
{ "BYTE" "Sbz1" }
{ "WORD" "AclSize" }
{ "WORD" "AceCount" }
{ "WORD" "Sbz2" } ;
TYPEDEF: ACL* PACL
: ACCESS_ALLOWED_ACE_TYPE 0 ; inline
: ACCESS_DENIED_ACE_TYPE 1 ; inline
: SYSTEM_AUDIT_ACE_TYPE 2 ; inline
: SYSTEM_ALARM_ACE_TYPE 3 ; inline
: OBJECT_INHERIT_ACE HEX: 1 ; inline
: CONTAINER_INHERIT_ACE HEX: 2 ; inline
: NO_PROPAGATE_INHERIT_ACE HEX: 4 ; inline
: INHERIT_ONLY_ACE HEX: 8 ; inline
: VALID_INHERIT_FLAGS HEX: f ; inline
C-STRUCT: ACE_HEADER
{ "BYTE" "AceType" }
{ "BYTE" "AceFlags" }
{ "WORD" "AceSize" } ;
TYPEDEF: ACE_HEADER* PACE_HEADER
C-STRUCT: ACCESS_ALLOWED_ACE
{ "ACE_HEADER" "Header" }
{ "DWORD" "Mask" }
{ "DWORD" "SidStart" } ;
TYPEDEF: ACCESS_ALLOWED_ACE* PACCESS_ALLOWED_ACE
C-STRUCT: ACCESS_DENIED_ACE
{ "ACE_HEADER" "Header" }
{ "DWORD" "Mask" }
{ "DWORD" "SidStart" } ;
TYPEDEF: ACCESS_DENIED_ACE* PACCESS_DENIED_ACE
C-STRUCT: SYSTEM_AUDIT_ACE
{ "ACE_HEADER" "Header" }
{ "DWORD" "Mask" }
{ "DWORD" "SidStart" } ;
TYPEDEF: SYSTEM_AUDIT_ACE* PSYSTEM_AUDIT_ACE
C-STRUCT: SYSTEM_ALARM_ACE
{ "ACE_HEADER" "Header" }
{ "DWORD" "Mask" }
{ "DWORD" "SidStart" } ;
TYPEDEF: SYSTEM_ALARM_ACE* PSYSTEM_ALARM_ACE
C-STRUCT: ACCESS_ALLOWED_CALLBACK_ACE
{ "ACE_HEADER" "Header" }
{ "DWORD" "Mask" }
{ "DWORD" "SidStart" } ;
TYPEDEF: ACCESS_ALLOWED_CALLBACK_ACE* PACCESS_ALLOWED_CALLBACK_ACE
! typedef enum _TOKEN_INFORMATION_CLASS {
: TokenUser 1 ; inline
: TokenGroups 2 ; inline
: TokenPrivileges 3 ; inline
: TokenOwner 4 ; inline
: TokenPrimaryGroup 5 ; inline
: TokenDefaultDacl 6 ; inline
: TokenSource 7 ; inline
: TokenType 8 ; inline
: TokenImpersonationLevel 9 ; inline
: TokenStatistics 10 ; inline
: TokenRestrictedSids 11 ; inline
: TokenSessionId 12 ; inline
: TokenGroupsAndPrivileges 13 ; inline
: TokenSessionReference 14 ; inline
: TokenSandBoxInert 15 ; inline
! } TOKEN_INFORMATION_CLASS;
: DELETE HEX: 00010000 ; inline
: READ_CONTROL HEX: 00020000 ; inline
: WRITE_DAC HEX: 00040000 ; inline
: WRITE_OWNER HEX: 00080000 ; inline
: SYNCHRONIZE HEX: 00100000 ; inline
: STANDARD_RIGHTS_REQUIRED HEX: 000f0000 ; inline
: STANDARD_RIGHTS_READ READ_CONTROL ; inline
: STANDARD_RIGHTS_WRITE READ_CONTROL ; inline
: STANDARD_RIGHTS_EXECUTE READ_CONTROL ; inline
: TOKEN_TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
: TOKEN_ADJUST_GROUPS HEX: 0040 ; inline
: TOKEN_ADJUST_PRIVILEGES HEX: 0020 ; inline
: TOKEN_ADJUST_SESSIONID HEX: 0100 ; inline
: TOKEN_ASSIGN_PRIMARY HEX: 0001 ; inline
: TOKEN_DUPLICATE HEX: 0002 ; inline
: TOKEN_EXECUTE STANDARD_RIGHTS_EXECUTE ; inline
: TOKEN_IMPERSONATE HEX: 0004 ; inline
: TOKEN_QUERY HEX: 0008 ; inline
: TOKEN_QUERY_SOURCE HEX: 0010 ; inline
: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ;
: TOKEN_WRITE
{
STANDARD_RIGHTS_WRITE
TOKEN_ADJUST_PRIVILEGES
TOKEN_ADJUST_GROUPS
TOKEN_ADJUST_DEFAULT
} flags ; foldable
: TOKEN_ALL_ACCESS
{
STANDARD_RIGHTS_REQUIRED
TOKEN_ASSIGN_PRIMARY
TOKEN_DUPLICATE
TOKEN_IMPERSONATE
TOKEN_QUERY
TOKEN_QUERY_SOURCE
TOKEN_ADJUST_PRIVILEGES
TOKEN_ADJUST_GROUPS
TOKEN_ADJUST_SESSIONID
TOKEN_ADJUST_DEFAULT
} flags ; foldable
! : I_ScGetCurrentGroupStateW ;
! : A_SHAFinal ;
@ -85,7 +212,7 @@ LIBRARY: advapi32
! : AddAccessDeniedAce ;
! : AddAccessDeniedAceEx ;
! : AddAccessDeniedObjectAce ;
! : AddAce ;
FUNCTION: BOOL AddAce ( PACL pAcl, DWORD dwAceRevision, DWORD dwStartingAceIndex, LPVOID pAceList, DWORD nAceListLength ) ;
! : AddAuditAccessAce ;
! : AddAuditAccessAceEx ;
! : AddAuditAccessObjectAce ;
@ -382,7 +509,7 @@ FUNCTION: BOOL GetUserNameW ( LPCTSTR lpBuffer, LPDWORD lpnSize ) ;
! : ImpersonateLoggedOnUser ;
! : ImpersonateNamedPipeClient ;
! : ImpersonateSelf ;
! : InitializeAcl ;
FUNCTION: BOOL InitializeAcl ( PACL pAcl, DWORD nAclLength, DWORD dwAclRevision ) ;
! : InitializeSecurityDescriptor ;
! : InitializeSid ;
! : InitiateSystemShutdownA ;
@ -508,70 +635,6 @@ FUNCTION: BOOL LookupPrivilegeValueW ( LPCTSTR lpSystemName,
! : OpenEventLogA ;
! : OpenEventLogW ;
! typedef enum _TOKEN_INFORMATION_CLASS {
: TokenUser 1 ;
: TokenGroups 2 ;
: TokenPrivileges 3 ;
: TokenOwner 4 ;
: TokenPrimaryGroup 5 ;
: TokenDefaultDacl 6 ;
: TokenSource 7 ;
: TokenType 8 ;
: TokenImpersonationLevel 9 ;
: TokenStatistics 10 ;
: TokenRestrictedSids 11 ;
: TokenSessionId 12 ;
: TokenGroupsAndPrivileges 13 ;
: TokenSessionReference 14 ;
: TokenSandBoxInert 15 ;
! } TOKEN_INFORMATION_CLASS;
: DELETE HEX: 00010000 ; inline
: READ_CONTROL HEX: 00020000 ; inline
: WRITE_DAC HEX: 00040000 ; inline
: WRITE_OWNER HEX: 00080000 ; inline
: SYNCHRONIZE HEX: 00100000 ; inline
: STANDARD_RIGHTS_REQUIRED HEX: 000f0000 ; inline
: STANDARD_RIGHTS_READ READ_CONTROL ; inline
: STANDARD_RIGHTS_WRITE READ_CONTROL ; inline
: STANDARD_RIGHTS_EXECUTE READ_CONTROL ; inline
: TOKEN_TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
: TOKEN_ADJUST_GROUPS HEX: 0040 ; inline
: TOKEN_ADJUST_PRIVILEGES HEX: 0020 ; inline
: TOKEN_ADJUST_SESSIONID HEX: 0100 ; inline
: TOKEN_ASSIGN_PRIMARY HEX: 0001 ; inline
: TOKEN_DUPLICATE HEX: 0002 ; inline
: TOKEN_EXECUTE STANDARD_RIGHTS_EXECUTE ; inline
: TOKEN_IMPERSONATE HEX: 0004 ; inline
: TOKEN_QUERY HEX: 0008 ; inline
: TOKEN_QUERY_SOURCE HEX: 0010 ; inline
: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ;
: TOKEN_WRITE
{
STANDARD_RIGHTS_WRITE
TOKEN_ADJUST_PRIVILEGES
TOKEN_ADJUST_GROUPS
TOKEN_ADJUST_DEFAULT
} flags ; foldable
: TOKEN_ALL_ACCESS
{
STANDARD_RIGHTS_REQUIRED
TOKEN_ASSIGN_PRIMARY
TOKEN_DUPLICATE
TOKEN_IMPERSONATE
TOKEN_QUERY
TOKEN_QUERY_SOURCE
TOKEN_ADJUST_PRIVILEGES
TOKEN_ADJUST_GROUPS
TOKEN_ADJUST_SESSIONID
TOKEN_ADJUST_DEFAULT
} flags ; foldable
FUNCTION: BOOL OpenProcessToken ( HANDLE ProcessHandle,
DWORD DesiredAccess,
PHANDLE TokenHandle ) ;

22
extra/windows/messages/messages.factor
View File

@ -1001,3 +1001,25 @@ windows-messages set-global
: LM_GETIDEALHEIGHT WM_USER HEX: 0301 + ; inline
: LM_SETITEM WM_USER HEX: 0302 + ; inline
: LM_GETITEM WM_USER HEX: 0303 + ; inline
: WA_INACTIVE 0 ; inline
: WA_ACTIVE 1 ; inline
: WA_CLICKACTIVE 2 ; inline
: SC_SIZE HEX: f000 ; inline
: SC_MOVE HEX: f010 ; inline
: SC_MINIMIZE HEX: f020 ; inline
: SC_MAXIMIZE HEX: f030 ; inline
: SC_NEXTWINDOW HEX: f040 ; inline
: SC_PREVWINDOW HEX: f050 ; inline
: SC_CLOSE HEX: f060 ; inline
: SC_VSCROLL HEX: f070 ; inline
: SC_HSCROLL HEX: f080 ; inline
: SC_MOUSEMENU HEX: f090 ; inline
: SC_KEYMENU HEX: f100 ; inline
: SC_ARRANGE HEX: f110 ; inline
: SC_RESTORE HEX: f120 ; inline
: SC_TASKLIST HEX: f130 ; inline
: SC_SCREENSAVE HEX: f140 ; inline
: SC_HOTKEY HEX: f150 ; inline