From f49d26e8d060c745b31dd72454462d0625cef2eb Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 01:13:29 -0500 Subject: [PATCH 1/4] make copy-tree and delete-tree symlink aware --- core/io/files/files.factor | 30 ++++++++++++++++++------------ extra/io/unix/files/files.factor | 19 +++++++++++++++---- extra/unix/unix.factor | 4 ++++ 3 files changed, 37 insertions(+), 16 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 48098e612d..4dbbb869c4 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,7 +3,7 @@ USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions system combinators splitting sbufs continuations io.encodings -io.encodings.binary init ; +io.encodings.binary init accessors ; IN: io.files HOOK: (file-reader) io-backend ( path -- stream ) @@ -145,8 +145,14 @@ PRIVATE> TUPLE: file-info type size permissions modified ; HOOK: file-info io-backend ( path -- info ) + +! Symlinks HOOK: link-info io-backend ( path -- info ) +HOOK: make-link io-backend ( path1 path2 -- ) + +HOOK: read-link io-backend ( path -- info ) + SYMBOL: +regular-file+ SYMBOL: +directory+ SYMBOL: +character-device+ @@ -218,14 +224,14 @@ HOOK: delete-file io-backend ( path -- ) HOOK: delete-directory io-backend ( path -- ) -: (delete-tree) ( path dir? -- ) - [ - dup directory* [ (delete-tree) ] assoc-each - delete-directory - ] [ delete-file ] if ; - : delete-tree ( path -- ) - dup directory? (delete-tree) ; + dup link-info type>> +directory+ = [ + dup directory over [ + [ first delete-tree ] each + ] with-directory delete-directory + ] [ + delete-file + ] if ; : to-directory over file-name append-path ; @@ -258,10 +264,10 @@ M: object copy-file DEFER: copy-tree-into : copy-tree ( from to -- ) - over directory? [ - >r dup directory swap r> [ - >r swap first append-path r> copy-tree-into - ] 2curry each + over link-info type>> +directory+ = [ + >r dup directory r> rot [ + [ >r first r> copy-tree-into ] curry each + ] with-directory ] [ copy-file ] if ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 3b493d2fe4..759ac2bec1 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -3,7 +3,7 @@ USING: io.backend io.nonblocking io.unix.backend io.files io unix unix.stat unix.time kernel math continuations math.bitfields byte-arrays alien combinators calendar -io.encodings.binary ; +io.encodings.binary accessors sequences strings ; IN: io.unix.files @@ -49,7 +49,7 @@ M: unix-io touch-file ( path -- ) close ; M: unix-io move-file ( from to -- ) - [ normalize-pathname ] 2apply rename io-error ; + [ normalize-pathname ] bi@ rename io-error ; M: unix-io delete-file ( path -- ) normalize-pathname unlink io-error ; @@ -69,7 +69,7 @@ M: unix-io delete-directory ( path -- ) ] with-disposal ; M: unix-io copy-file ( from to -- ) - [ normalize-pathname ] 2apply + [ normalize-pathname ] bi@ [ (copy-file) ] [ swap file-info file-info-permissions chmod io-error ] 2bi ; @@ -84,7 +84,7 @@ M: unix-io copy-file ( from to -- ) { [ dup S_ISLNK ] [ +symbolic-link+ ] } { [ dup S_ISSOCK ] [ +socket+ ] } { [ t ] [ +unknown+ ] } - } cond nip ; + } cond nip ; : stat>file-info ( stat -- info ) { @@ -100,3 +100,14 @@ M: unix-io file-info ( path -- info ) M: unix-io link-info ( path -- info ) normalize-pathname lstat* stat>file-info ; + +M: unix-io make-link ( path1 path2 -- ) + normalize-pathname symlink io-error ; + +M: unix-io read-link ( path -- path' ) + normalize-pathname + PATH_MAX [ tuck ] [ ] bi readlink + dup io-error head-slice >string ; + +: copy-link ( path1 path2 -- ) + >r read-link r> make-link ; diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index bed87ebd0f..ffd102901c 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -77,6 +77,7 @@ FUNCTION: int pclose ( void* file ) ; FUNCTION: int pipe ( int* filedes ) ; FUNCTION: void* popen ( char* command, char* type ) ; FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ; +FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ; FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ; FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ; FUNCTION: int rename ( char* from, char* to ) ; @@ -93,6 +94,7 @@ FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_ FUNCTION: int setuid ( uid_t uid ) ; FUNCTION: int socket ( int domain, int type, int protocol ) ; FUNCTION: char* strerror ( int errno ) ; +FUNCTION: int symlink ( char* path1, char* path2 ) ; FUNCTION: int system ( char* command ) ; FUNCTION: int unlink ( char* path ) ; FUNCTION: int utimes ( char* path, timeval[2] times ) ; @@ -102,6 +104,8 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ; FUNCTION: int kill ( pid_t pid, int sig ) ; +: PATH_MAX 1024 ; inline + : PRIO_PROCESS 0 ; inline : PRIO_PGRP 1 ; inline : PRIO_USER 2 ; inline From b4d2a0b1051061b37a68e80a92bd8673eaa30fb5 Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 01:14:28 -0500 Subject: [PATCH 2/4] add constant to grovel --- build-support/grovel.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/build-support/grovel.c b/build-support/grovel.c index 2eee054dab..db16aa9bca 100644 --- a/build-support/grovel.c +++ b/build-support/grovel.c @@ -42,6 +42,7 @@ #include #include #include + #include #include #include #endif @@ -146,6 +147,7 @@ void unix_constants() constant(PROT_WRITE); constant(MAP_FILE); constant(MAP_SHARED); + constant(PATH_MAX); grovel(pid_t); } From 883c54e07765773cf3a30d9478c7f45e14747f39 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Mar 2008 06:45:38 -0500 Subject: [PATCH 3/4] use srandom and prandom on openbsd /dev/random is reserved for hardware rngs.. --- extra/random/unix/unix.factor | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/extra/random/unix/unix.factor b/extra/random/unix/unix.factor index 51574887e3..f3f55007f0 100644 --- a/extra/random/unix/unix.factor +++ b/extra/random/unix/unix.factor @@ -1,6 +1,6 @@ USING: alien.c-types io io.files io.nonblocking kernel namespaces random io.encodings.binary singleton init -accessors ; +accessors system ; IN: random.unix TUPLE: unix-random path ; @@ -15,7 +15,14 @@ C: unix-random M: unix-random random-bytes* ( n tuple -- byte-array ) path>> file-read-unbuffered ; -[ - "/dev/random" secure-random-generator set-global - "/dev/urandom" insecure-random-generator set-global -] "random.unix" add-init-hook +os "openbsd" = [ + [ + "/dev/srandom" secure-random-generator set-global + "/dev/prandom" insecure-random-generator set-global + ] "random.unix" add-init-hook +] [ + [ + "/dev/random" secure-random-generator set-global + "/dev/urandom" insecure-random-generator set-global + ] "random.unix" add-init-hook +] if From 6ece2fbde270b4b1c725f84e09e701fc66723642 Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 14:48:49 -0500 Subject: [PATCH 4/4] fix copy-tree --- core/io/files/files.factor | 20 +++++++++++++------- extra/io/unix/files/files.factor | 3 --- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 4dbbb869c4..458a9145a6 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -153,6 +153,9 @@ HOOK: make-link io-backend ( path1 path2 -- ) HOOK: read-link io-backend ( path -- info ) +: copy-link ( path1 path2 -- ) + >r read-link r> make-link ; + SYMBOL: +regular-file+ SYMBOL: +directory+ SYMBOL: +character-device+ @@ -264,13 +267,16 @@ M: object copy-file DEFER: copy-tree-into : copy-tree ( from to -- ) - over link-info type>> +directory+ = [ - >r dup directory r> rot [ - [ >r first r> copy-tree-into ] curry each - ] with-directory - ] [ - copy-file - ] if ; + over link-info type>> + { + { +symbolic-link+ [ copy-link ] } + { +directory+ [ + >r dup directory r> rot [ + [ >r first r> copy-tree-into ] curry each + ] with-directory + ] } + [ drop copy-file ] + } case ; : copy-tree-into ( from to -- ) to-directory copy-tree ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 759ac2bec1..c4e506d37f 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -108,6 +108,3 @@ M: unix-io read-link ( path -- path' ) normalize-pathname PATH_MAX [ tuck ] [ ] bi readlink dup io-error head-slice >string ; - -: copy-link ( path1 path2 -- ) - >r read-link r> make-link ;