From 7103cc3cda5ee76279b7e5056a7c27781d4f92b1 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 18 Dec 2008 18:32:00 -0600 Subject: [PATCH 1/6] Add follow-link/follow-links, use it in file-system-info on linux. add docs and unit tests. fix indentation --- basis/io/files/info/unix/linux/linux.factor | 19 ++++++++---- basis/io/files/info/windows/windows.factor | 5 +--- basis/io/files/links/links-docs.factor | 33 +++++++++++++++++++-- basis/io/files/links/links-tests.factor | 31 +++++++++++++++++++ basis/io/files/links/links.factor | 27 +++++++++++++++-- basis/io/files/links/unix/unix.factor | 2 +- 6 files changed, 103 insertions(+), 14 deletions(-) create mode 100644 basis/io/files/links/links-tests.factor diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor index ee4a1ed91f..69a5597dd4 100644 --- a/basis/io/files/info/unix/linux/linux.factor +++ b/basis/io/files/info/unix/linux/linux.factor @@ -3,8 +3,9 @@ USING: accessors alien.c-types alien.syntax combinators csv io.backend io.encodings.utf8 io.files io.files.info io.streams.string io.files.unix kernel math.order namespaces sequences sorting -system unix unix.statfs.linux unix.statvfs.linux -specialized-arrays.direct.uint arrays io.files.info.unix ; +system unix unix.statfs.linux unix.statvfs.linux io.files.links.unix +specialized-arrays.direct.uint arrays io.files.info.unix assocs +io.pathnames ; IN: io.files.info.unix.linux TUPLE: linux-file-system-info < unix-file-system-info @@ -70,6 +71,16 @@ M: linux file-systems } cleave ] map ; +: (find-mount-point) ( path mtab-paths -- mtab-entry ) + [ follow-links ] dip 2dup at* [ + 2nip + ] [ + drop [ parent-directory ] dip (find-mount-point) + ] if ; + +: find-mount-point ( path -- mtab-entry ) + parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc (find-mount-point) ; + ERROR: file-system-not-found ; M: linux file-system-info ( path -- ) @@ -80,9 +91,7 @@ M: linux file-system-info ( path -- ) [ file-system-statvfs statvfs>file-system-info ] bi file-system-calculations ] keep - - parse-mtab [ [ mount-point>> ] bi@ <=> invert-comparison ] sort - [ mount-point>> head? ] with find nip [ file-system-not-found ] unless* + find-mount-point { [ file-system-name>> >>device-name drop ] [ mount-point>> >>mount-point drop ] diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index aecf42d9a2..cf826a59d3 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -102,10 +102,7 @@ M: windows link-info ( path -- info ) [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; : calculate-file-system-info ( file-system-info -- file-system-info' ) - { - [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] - [ ] - } cleave ; + [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] keep ; TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ; diff --git a/basis/io/files/links/links-docs.factor b/basis/io/files/links/links-docs.factor index 0e9a375da3..4d448e5372 100644 --- a/basis/io/files/links/links-docs.factor +++ b/basis/io/files/links/links-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax io.files.info ; +USING: help.markup help.syntax io.files.info math ; IN: io.files.links HELP: make-link @@ -15,9 +15,38 @@ HELP: copy-link { make-link read-link copy-link } related-words +HELP: follow-link +{ $values + { "path" "a pathname string" } + { "path'" "a pathname string" } +} +{ $description "Returns an absolute path from " { $link read-link } "." } ; + +HELP: follow-links +{ $values + { "path" "a pathname string" } + { "path'" "a pathname string" } +} +{ $description "Follows a chain of symlinks up to " { $link symlink-depth } "." } ; + +HELP: symlink-depth +{ $values + { "value" integer } +} +{ $description "The number of redirections " { $link follow-links } " will follow." } ; + +HELP: too-many-symlinks +{ $values + { "path" "a pathname string" } { "n" integer } +} +{ $description "An error thrown when the number of redirections in a chain of symlinks surpasses the value in the " { $link symlink-depth } " variable." } ; + ARTICLE: "io.files.links" "Symbolic links" -"Reading and creating links:" +"Reading links:" { $subsection read-link } +{ $subsection follow-link } +{ $subsection follow-links } +"Creating links:" { $subsection make-link } "Copying links:" { $subsection copy-link } diff --git a/basis/io/files/links/links-tests.factor b/basis/io/files/links/links-tests.factor new file mode 100644 index 0000000000..55caccb3ae --- /dev/null +++ b/basis/io/files/links/links-tests.factor @@ -0,0 +1,31 @@ +USING: io.directories io.files.links tools.test +io.files.unique tools.files ; +IN: io.files.links.tests + +: make-test-links ( n path -- ) + [ '[ [ 1+ ] keep [ number>string _ prepend ] bi@ make-link ] each ] + [ [ number>string ] dip prepend touch-file ] 2bi ; inline + +[ t ] [ + [ + 5 "lol" make-test-links + "lol1" follow-links + current-directory get "lol5" append-path = + ] with-unique-directory +] unit-test + +[ + [ + 100 "laf" make-test-links "laf1" follow-links + ] with-unique-directory +] [ too-many-symlinks? ] must-fail-with + +[ t ] [ + 110 symlink-depth [ + [ + 100 "laf" make-test-links + "laf1" follow-links + current-directory get "laf100" append-path = + ] with-unique-directory + ] with-variable +] unit-test diff --git a/basis/io/files/links/links.factor b/basis/io/files/links/links.factor index 02e1a1b078..8d13de723c 100644 --- a/basis/io/files/links/links.factor +++ b/basis/io/files/links/links.factor @@ -1,6 +1,8 @@ ! Copyright (C) 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: system kernel vocabs.loader ; +USING: accessors io.backend io.files.info +io.files.links.private io.files.types io.pathnames kernel math +namespaces system unix vocabs.loader ; IN: io.files.links HOOK: make-link os ( target symlink -- ) @@ -10,4 +12,25 @@ HOOK: read-link os ( symlink -- path ) : copy-link ( target symlink -- ) [ read-link ] dip make-link ; -os unix? [ "io.files.links.unix" require ] when \ No newline at end of file +os unix? [ "io.files.links.unix" require ] when + +: follow-link ( path -- path' ) + [ parent-directory ] [ read-symbolic-link ] bi append-path ; + +SYMBOL: symlink-depth +10 symlink-depth set-global + +ERROR: too-many-symlinks path n ; + +> +symbolic-link+ = + [ [ 1- ] [ follow-link ] bi* (follow-links) ] + [ nip ] if ; inline recursive + +PRIVATE> + +: follow-links ( path -- path' ) + [ symlink-depth get ] dip normalize-path (follow-links) ; diff --git a/basis/io/files/links/unix/unix.factor b/basis/io/files/links/unix/unix.factor index 69b31c6874..2f38c39e02 100644 --- a/basis/io/files/links/unix/unix.factor +++ b/basis/io/files/links/unix/unix.factor @@ -7,4 +7,4 @@ M: unix make-link ( path1 path2 -- ) normalize-path symlink io-error ; M: unix read-link ( path -- path' ) - normalize-path read-symbolic-link ; + normalize-path read-symbolic-link ; From 180aeea68d96aaa1739139ddd0b00c847fe02693 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Dec 2008 18:40:01 -0600 Subject: [PATCH 2/6] fix using. add --- basis/io/files/links/links.factor | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/basis/io/files/links/links.factor b/basis/io/files/links/links.factor index 8d13de723c..21cab64a2f 100644 --- a/basis/io/files/links/links.factor +++ b/basis/io/files/links/links.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors io.backend io.files.info -io.files.links.private io.files.types io.pathnames kernel math -namespaces system unix vocabs.loader ; +USING: accessors io.backend io.files.info io.files.types +io.pathnames kernel math namespaces system unix vocabs.loader ; IN: io.files.links HOOK: make-link os ( target symlink -- ) From a326943f8bfad933cf2508e5607caf45b47ed3f6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Dec 2008 18:42:05 -0600 Subject: [PATCH 3/6] better related-words for follow-links. add --- basis/io/files/links/links-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/files/links/links-docs.factor b/basis/io/files/links/links-docs.factor index 4d448e5372..8419399c92 100644 --- a/basis/io/files/links/links-docs.factor +++ b/basis/io/files/links/links-docs.factor @@ -13,8 +13,6 @@ HELP: copy-link { $values { "target" "a path to an existing symlink" } { "symlink" "a path to a new symbolic link" } } { $description "Copies a symbolic link without following the link." } ; -{ make-link read-link copy-link } related-words - HELP: follow-link { $values { "path" "a pathname string" } @@ -29,6 +27,8 @@ HELP: follow-links } { $description "Follows a chain of symlinks up to " { $link symlink-depth } "." } ; +{ read-link follow-link follow-links } related-words + HELP: symlink-depth { $values { "value" integer } From 513b4b37084125c522924d3d124907bbd9d223e5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Dec 2008 19:32:09 -0600 Subject: [PATCH 4/6] use read-link instead, remove dependency on unix. oops --- basis/io/files/links/links.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/files/links/links.factor b/basis/io/files/links/links.factor index 21cab64a2f..1212d579db 100644 --- a/basis/io/files/links/links.factor +++ b/basis/io/files/links/links.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors io.backend io.files.info io.files.types -io.pathnames kernel math namespaces system unix vocabs.loader ; +io.pathnames kernel math namespaces system vocabs.loader ; IN: io.files.links HOOK: make-link os ( target symlink -- ) @@ -14,7 +14,7 @@ HOOK: read-link os ( symlink -- path ) os unix? [ "io.files.links.unix" require ] when : follow-link ( path -- path' ) - [ parent-directory ] [ read-symbolic-link ] bi append-path ; + [ parent-directory ] [ read-link ] bi append-path ; SYMBOL: symlink-depth 10 symlink-depth set-global From 4f1aefd3fe23c9a377bf49706780293bcac8fbad Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Dec 2008 19:57:21 -0600 Subject: [PATCH 5/6] fix bootstrap --- basis/io/files/info/unix/linux/linux.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor index 69a5597dd4..60313b3306 100644 --- a/basis/io/files/info/unix/linux/linux.factor +++ b/basis/io/files/info/unix/linux/linux.factor @@ -3,7 +3,7 @@ USING: accessors alien.c-types alien.syntax combinators csv io.backend io.encodings.utf8 io.files io.files.info io.streams.string io.files.unix kernel math.order namespaces sequences sorting -system unix unix.statfs.linux unix.statvfs.linux io.files.links.unix +system unix unix.statfs.linux unix.statvfs.linux io.files.links specialized-arrays.direct.uint arrays io.files.info.unix assocs io.pathnames ; IN: io.files.info.unix.linux From 88ec8786fd50ada80ce22c0876856857f264b3c4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Dec 2008 20:31:22 -0600 Subject: [PATCH 6/6] add using --- basis/io/files/links/links-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/files/links/links-tests.factor b/basis/io/files/links/links-tests.factor index 55caccb3ae..2d142ce900 100644 --- a/basis/io/files/links/links-tests.factor +++ b/basis/io/files/links/links-tests.factor @@ -1,5 +1,5 @@ USING: io.directories io.files.links tools.test -io.files.unique tools.files ; +io.files.unique tools.files fry ; IN: io.files.links.tests : make-test-links ( n path -- )