Wednesday, January 12, 2011

Trashing Files: Part 2 (Unix)

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:

  1. The path is to a directory
  2. The path has the sticky-bit set
  3. 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:

  1. In $XDG_DATA_HOME/Trash (or $HOME/.local/share/Trash), if the file being trashed is on the same mount point.
  2. In the top directory of the path's mount point, $TOPDIR/.Trash/$UID, if the .Trash directory is available.
  3. 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:

  1. Lookup the trash path for the file being trashed
  2. Move the trashed file into a files sub-directory, using a safe file name
  3. 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: