In Part 1, we implemented send-to-trash
on Mac OS. In Part 2, we will be adding Factor support for the FreeDesktop.org Trash Specification used on other Unix systems (e.g., Linux or BSD).
trash.unix
First, we need to create the trash.unix
vocabulary:
USING: accessors calendar combinators.short-circuit environment formatting io io.directories io.encodings.utf8 io.files io.files.info io.files.info.unix io.files.types io.pathnames kernel math math.parser sequences system trash unix.stat unix.users ; IN: trash.unix
When trashing a file, we sometimes need to look for the "top directory" of a mounted resource that contains a given path. We can use the lstat function (using the link-status
word from unix.stat
) to read information about the file or symbol link pointed to by a path. If the file system details are different between a path and its parent directory, then it is the top directory of a mounted resource.
: top-directory? ( path -- ? ) dup ".." append-path [ link-status ] bi@ [ [ st_dev>> ] bi@ = not ] [ [ st_ino>> ] bi@ = ] 2bi or ; : top-directory ( path -- path' ) [ dup top-directory? not ] [ ".." append-path ] while ;
We need to be able to create trash directories with "user-only" permissions:
: make-user-directory ( path -- ) [ make-directories ] [ OCT: 700 set-file-permissions ] bi ;
To be a valid trash path, we need to check:
- The path is to a directory
- The path has the sticky-bit set
- The path should not be a symbolic link
: check-trash-path ( path -- ) { [ file-info directory? ] [ sticky? ] [ link-info type>> +symbolic-link+ = not ] } 1&& [ "invalid trash path" throw ] unless ;
The FreeDesktop.org Trash Specification defines various locations for the trash directory, in order of preference:
- In
$XDG_DATA_HOME/Trash
(or$HOME/.local/share/Trash
), if the file being trashed is on the same mount point. - In the top directory of the path's mount point,
$TOPDIR/.Trash/$UID
, if the.Trash
directory is available. - In the top directory of the path's mount point,
$TOPDIR/.Trash-$UID
, in a user-created directory.
: trash-home ( -- path ) "XDG_DATA_HOME" os-env home ".local/share" append-path or "Trash" append-path dup check-trash-path ; : trash-1 ( root -- path ) ".Trash" append-path dup check-trash-path real-user-id number>string append-path ; : trash-2 ( root -- path ) real-user-id ".Trash-%d" sprintf append-path ; : trash-path ( path -- path' ) top-directory dup trash-home top-directory = [ drop trash-home ] [ dup ".Trash" append-path exists? [ trash-1 ] [ trash-2 ] if [ make-user-directory ] keep ] if ;
We need to implement some logic to handle name collisions (e.g., when trashing a file with the same name as a file already in the trash directory). To do this, we use "safe" filenames (adding an incrementing extension to ensure uniqueness):
: (safe-file-name) ( path counter -- path' ) [ [ parent-directory ] [ file-stem ] [ file-extension dup [ "." prepend ] when ] tri ] dip swap "%s%s %s%s" sprintf ; : safe-file-name ( path -- path' ) dup 0 [ over exists? ] [ [ parent-directory to-directory ] [ 1 + ] bi* [ (safe-file-name) ] keep ] while drop nip ;
And, finally, we can implement the send-to-trash
logic:
- Lookup the trash path for the file being trashed
- Move the trashed file into a
files
sub-directory, using a safe file name - Create an "information file" in an
info
sub-directory, with details of the trashed file.
M: unix send-to-trash ( path -- ) dup trash-path [ "files" append-path [ make-user-directory ] keep to-directory safe-file-name ] [ "info" append-path [ make-user-directory ] keep to-directory ".trashinfo" append [ over ] dip utf8 [ "[Trash Info]" write nl "Path=" write write nl "DeletionDate=" write now "%Y-%m-%dT%H:%M:%S" strftime write nl ] with-file-writer ] bi move-file ;
The code for this is on my Github.
No comments:
Post a Comment