dexter/app/dexter.pl

#! /usr/bin/perl

use Module::Installed::Tiny qw(module_installed);

use Mojolicious::Lite -signatures;

use Encode::Locale;
use Encode;

use Readonly;

use Cwd;
use File::Path;
use File::Spec;
use File::Find;
use File::Copy;

use if module_installed('OpenBSD::Unveil'), 'OpenBSD::Unveil';



Readonly my $TERABYTE => 1_000_000_000_000;
Readonly my $GIGABYTE => 1_000_000_000;
Readonly my $MEGABYTE => 1_000_000;
Readonly my $KILOBYTE => 1_000;

Readonly::Hash my %MEANING_OF_HTTP_CODE => (
    '301' => 'Permanent Redirect',
    '400' => 'Bad Request',
    '403' => 'Forbidden',
    '404' => 'File Not Found',
    '409' => 'Conflict',
    '413' => 'Payload Too Large',
    '500' => 'Internal Server Error',
);

Readonly my $ROOT_DIRECTORY   => 'public';
Readonly my $SOCKET_DIRECTORY => '/var/www/run';
Readonly my $TEMP_DIRECTORY   => '/tmp/dexter';
Readonly my $FS_ENCODING      => 'UTF-8';
Readonly my $MAX_REQUEST_SIZE => $GIGABYTE;

mkdir $TEMP_DIRECTORY;

Readonly::Hash my %PERMISSIONS => (
    NONE   => 0,
    READ   => 4,
    CREATE => 2,
    DELETE => 1,
    MOVE   => 3,
    ALL    => 7
);

Readonly::Hash my %USER_ACCESS_RULES => (
    admin => [ [ qr/^\/$/, $PERMISSIONS{READ} ],
               [ qr/.*/,   $PERMISSIONS{ALL}  ] ],
    
    guest => [ [ qr/.*/,   $PERMISSIONS{READ} ] ]
);



get '/' => sub ($c) {
    $c->req->url->path->leading_slash(1);
    $c->render_index;

    return 1;
};

get '*' => sub ($c) {
    my $url  = $c->req->url;
    my $path = $url->path;
    $path    = sanitize_path($path);
    
    if ( not $path->trailing_slash ) {
        $url->path->trailing_slash(1);
        $url = $url->to_abs;

        $c->res->headers->location($url->to_string);
        $c->render(template => 'error',
                    status  => '301',
                    message => 'Directory requests must end in a slash!');

        return 0;
    }

    $c->render_index;

    return 1;
};

post '/' => sub ($c) {
    $c->req->url->path->leading_slash(1);
    $c->handle_post;

    return 1;
};

post '*' => sub ($c) {
    my $url  = $c->req->url;
    my $path = $url->path;
    $path    = sanitize_path($path);
    
    if ( not $path->trailing_slash ) {
        $url->path->trailing_slash(1);
        $url = $url->to_abs;

        $c->res->headers->location($url->to_string);
        $c->render(template => 'error',
                    status  => '301',
                    message => 'POST requests must end in a slash!');

        return 0;
    }

    $c->handle_post;

    return 1;
};



helper render_index => sub ($c) {
    my $url  = $c->req->url;
    my $user = $c->req->env->{REMOTE_USER};
    my $path = $url->path;

    if ( not user_has_permission_on_path($user, 'READ', $path) ) {
        $c->render(template => 'error',
                    status  => '403',
                    message => 'You are not allowed to view that index!');

        return 0;
    }

    if ( not -r $ROOT_DIRECTORY . $path->to_route ) {
        $path->trailing_slash(0);
        $path = $path->to_dir;
        $url->path($path);

        $c->render(template => 'error',
                    status  => '500',
                    message => 'Dexter cannot read that file or index!');

        return 0;
    }

    if ( not -d $ROOT_DIRECTORY . $path->to_route ) {
        $path->trailing_slash(0);
        $path = $path->to_dir;
        $url->path($path);

        $c->render(template => 'error',
                    status  => '404',
                    message => 'That file does not exist!');

        return 0;
    }

    my $sort_query      = $url->query->param('sort');
    my $files_hash_ref  = get_files_at_path_sorted_by_query($path, $sort_query);

    my $sorts_hash_ref = get_sorts_hash_from_query($sort_query);

    $c->render(template => 'index',
                FILES   => $files_hash_ref,
                SORTS   => $sorts_hash_ref);
};

helper handle_post => sub ($c) {
    my $req         = $c->req;
    my $url         = $req->url;
    my $user        = $req->env->{REMOTE_USER};
    my $intent      = $req->param('intent');
    my $target_path = $req->param('target_path');
    my $dest_path   = $req->param('dest_path');
    
    $target_path = turn_string_into_path_using_url($target_path, $url);
    $dest_path   = turn_string_into_path_using_url($dest_path, $url);
    
    my $code    = 200;
    my $message = '';

    if ( $intent eq 'upload' ) {
        my $upload_file = $c->param('upload');

        if ( $upload_file->size == 0 ) {
            $c->render(template => 'error',
                        status  => '400',
                        message => 'No file uploaded or file is empty!');
            
            return 0;
        }

        if ( $c->req->is_limit_exceeded ) {
            my $size    = make_size_human_readable($MAX_REQUEST_SIZE);
            my $message = "Your upload is too large! Maximum size is $size.";

            $c->render(template => 'error',
                        status  => '413',
                        message => $message);
            
            return 0;
        }

        ( $code, $message )
            = user_save_file_to_path($user, $upload_file, $target_path);
    }
    elsif ( $intent eq 'mkdir' ) {
        ( $code, $message ) = user_mkdir_at_path($user, $target_path);
        
        $target_path = $target_path->trailing_slash(1);
    }
    elsif ( $intent eq 'delete' ) {
        ( $code, $message ) = user_delete_path($user, $target_path);
    }
    elsif ( $intent eq 'move' ) {
        ( $code, $message )
            = user_move_path_to_path($user, $target_path, $dest_path);
        
        $target_path = $dest_path;
    }
    else {
        $c->render(template => 'error',
                    status  => '400',
                    message => "Intent '$intent' is not supported!");
        
        return 0;
    }

    if ( $code != 200 ) {
        $c->render(template => 'error',
                    status  => "$code",
                    message => $message);
        
        return 0;
    }

    $c->redirect_to($target_path->to_dir);

    return 1;
};

helper make_size_human_readable => sub ($, $size) {
    return make_size_human_readable($size);
};

helper permission_available_at_path => sub ($c, $permission, $path) {
    return 0 if $path eq '../';

    my $user         = $c->req->env->{REMOTE_USER};
    my $current_path = $c->req->url->path;
    my $new_path     = $current_path->clone->merge($path);

    return user_has_permission_on_path($user, $permission, $new_path);
};

helper meaning_of_code => sub ($, $code) {
    return $MEANING_OF_HTTP_CODE{$code};
};



sub sanitize_path ($path) {
    my $path_string = $path->clone->canonicalize->to_string;

    while ( $path_string =~ m/^\/*\.+/ ) { # While path starts with slashes/dots.
        $path_string =~ s/^\/*\.+//; # Remove the slashes/dots.
    }

    return Mojo::Path->new($path_string)->leading_slash(1);
}

sub user_has_permission_on_path ($user, $permission, $path) {
    $user = 'guest' if not defined $user or $user eq '';

    my $rules_ref = $USER_ACCESS_RULES{$user};

    foreach my $rule_ref (@$rules_ref) {
        my $regex      = $rule_ref->[0];
        my $permit     = $rule_ref->[1];
        my $permission = $PERMISSIONS{$permission};

        next if not $path->to_route =~ m/$regex/;

        return ( $permission & $permit ) == $permission;
    }

    return 0;
}

sub get_files_at_path_sorted_by_query ($path, $sort_query) {
    my $files_ref = get_files_at_path($path);
    $files_ref    = sort_files_in_array_by_query($files_ref, $sort_query);

    return $files_ref;
}

sub get_sorts_hash_from_query ($query_string) {
    my ( $sort_type, $sort_order ) = parse_sort_query($query_string);
    my $opposite_order             = opposite_order($sort_order);
    my $symbol                     = sort_symbol_for_order($sort_order);
    my %hash                       = ();

    $hash{$sort_type}{order}  = $opposite_order;
    $hash{$sort_type}{symbol} = " $symbol";

    foreach ( 'name', 'size', 'date' ) {
        next if exists $hash{$_};

        $hash{$_}{order}  = $sort_order;
        $hash{$_}{symbol} = '';
    }

    return \%hash;
}

sub turn_string_into_path_using_url ($string, $url) {
    my $path = $url->path->clone->merge($string);
    $path    = sanitize_path($path);
    $path    = $path->trailing_slash(0);
}

sub make_size_human_readable ($size) {
    if ( $size < $KILOBYTE ) {
        $size = "$size byte" . ( $size == 1 ? q{} : "s" );
    }
    elsif ( $size < $MEGABYTE ) {
        $size = sprintf "%.2f KB", $size / $KILOBYTE;
    }
    elsif ( $size < $GIGABYTE ) {
        $size = sprintf "%.2f MB", $size / $MEGABYTE;
    }
    elsif ( $size < $TERABYTE ) {
        $size = sprintf "%.2f GB", $size / $GIGABYTE;
    }
    else {
        $size = sprintf "%.2f TB", $size / $TERABYTE;
    }

    return $size;
}

sub user_save_file_to_path ($user, $file, $path) {
    my ( $code, $message ) = check_user_can_create_file($user, $path);
       ( $code, $message ) = check_dexter_can_create_file($path);
    return $code, $message if $code != 200;

    my $path_string = $ROOT_DIRECTORY . $path->to_route;
    $file->move_to($path_string)
        or return 500, "Could not upload file '$path_string'!";
    
    return 200, 'OK';
}

sub user_mkdir_at_path ($user, $path) {
    my ( $code, $message ) = check_user_can_create_file($user, $path);
       ( $code, $message ) = check_dexter_can_create_file($path);
    return $code, $message if $code != 200;

    my $path_string = $ROOT_DIRECTORY . $path->to_route;
    mkdir($path_string)
        or return 500, "Directory '$path_string' could not be created!";

    return 200, 'OK';
}

sub user_delete_path ($user, $path) {
    my ( $code, $message ) = check_user_can_delete_file($user, $path);
       ( $code, $message ) = check_dexter_can_edit_file($path);
    return $code, $message if $code != 200;

    my $path_string = $ROOT_DIRECTORY . $path->to_route;
    my $err         = 0;
    if ( -d $path_string ) {
        $err = not rmtree($path_string);
    }
    else {
        $err = not unlink($path_string);
    }

    if ( $err ) {
        return 500, "'$path_string' could not be deleted!";
    }

    return 200, 'OK';
}

sub user_move_path_to_path ($user, $path, $new_path) {
    my ( $code, $message ) = check_user_can_delete_file($user, $path);
       ( $code, $message ) = check_dexter_can_edit_file($path);
    return $code, $message if $code != 200;

    ( $code, $message ) = check_user_can_create_file($user, $new_path);
    ( $code, $message ) = check_dexter_can_create_file($new_path);
    return $code, $message if $code != 200;

    my $path_string     = $ROOT_DIRECTORY . $path->to_route;
    my $new_path_string = $ROOT_DIRECTORY . $new_path->to_route;
    move($path_string, $new_path_string)
        or return 500,
            "Could not move file '$path_string' to '$new_path_string'!";
    
    return 200, 'OK';
}

sub get_files_at_path ($path) {
    my $path_string    = $path->to_route;
    my $directory_path = $ROOT_DIRECTORY . $path_string;

    opendir my $directory, $directory_path or return ();
    my @file_names = readdir $directory;
    closedir $directory;

    my $dir = getcwd;
    chdir($directory_path);

    my @files = ();

    foreach my $file_name (@file_names) {
        if ( $file_name =~ m{^[.]} ) { # If filename starts with dot.
            if ( $file_name ne '..' or $path eq '/' ) {
                next;
            }
        }

        my $file_ref = get_file_with_name($file_name);

        push @files, $file_ref;
    }

    chdir($dir);
    return \@files;
}

sub sort_files_in_array_by_query ($files_ref, $query_string) {
    my $routine_ref = build_sort_routine_from_query_string($query_string);

    $files_ref = sort_files_by_routine($files_ref, $routine_ref);

    return $files_ref;
}

sub opposite_order ($sort_order) {
    if ( $sort_order eq 'asc' ) {
        return 'desc';
    }
    else {
        return 'asc';
    }
}

sub sort_symbol_for_order ($sort_order) {
    if ( $sort_order eq 'asc' ) {
        return '↓';
    }
    else {
        return '↑';
    }
}

sub get_file_with_name ($name) {
    my (
        $device, $inode, $mode,    $nlink,  $uid, $gid, $rdev, $size, $atime,
        $mtime,  $ctime, $blksize, $blocks,
    ) = stat $name;

    my $type = 'file';
    if ( -d $name ) {
        $type = 'directory';
        find(sub { $size += -s if -f }, $name);
        $name = "$name/";
    }

    my %file = (
        name     => $name,
        name_dec => Encode::decode($FS_ENCODING, $name),
        device   => $device,
        inode    => $inode,
        mode     => $mode,
        nlink    => $nlink,
        uid      => $uid,
        gid      => $gid,
        rdev     => $rdev,
        size     => $size,
        atime    => $atime,
        mtime    => $mtime,
        ctime    => $ctime,
        blksize  => $blksize,
        blocks   => $blocks,
        type     => $type,
    );

    return \%file;
}

sub build_sort_routine_from_query_string ($query_string) {
    my ( $sort_type, $sort_order ) = parse_sort_query($query_string);

    my $try_swap = 0;
    if ( $sort_order eq 'asc' ) {
        $try_swap = sub ($c, $d) {
            return $c, $d;
        };
    }
    else {
        $try_swap = sub ($c, $d) {
            return $d, $c;
        };
    }

    my $compare = 0;
    if ( $sort_type eq 'date' ) {
        $compare = sub ($c, $d) {
            return $c->{mtime} <=> $d->{mtime};
        };
    }
    elsif ( $sort_type eq 'size') {
        $compare = sub ($c, $d) {
            return $c->{size} <=> $d->{size};
        };
    }
    else {
        $compare = sub ($c, $d) {
            return $c->{name} cmp $d->{name};
        };
    }

    return sub {
        if ( $a->{type} ne $b->{type} ) {
            if ( $a->{type} eq 'directory' ) {
                return -1;
            }
            else {
                return 1;
            }
        }

        if ( $a->{type} eq 'directory' and $b->{type} eq 'directory' ) {
            if ( $a->{name} eq '..' ) {
                return -1;
            }

            if ( $b->{name} eq '..' ) {
                return 1;
            }
        }

        my ( $c, $d ) = &$try_swap($a, $b);

        return &$compare($c, $d);
    };
}

sub sort_files_by_routine ($files_ref, $routine_ref) {
    my @files = @$files_ref;

    @files = sort $routine_ref @files;

    return \@files;
}

sub parse_sort_query ($query_string) {
    $query_string = 'name-asc' if not defined $query_string;

    my @split      = split('-', $query_string);
    my $sort_type  = $split[0];
    my $sort_order = '';

    if ( scalar @split > 1 ) {
        $sort_order = $split[1];
    }
    else {
        $sort_order = 'asc';
    }

    return $sort_type, $sort_order;
}

sub check_user_can_create_file ($user, $path) {
    my $path_string = $path->to_route;

    if ( not user_has_permission_on_path($user, 'CREATE', $path) ) {
        return 403, "You do not have permission to create '$path_string'!";
    }

    if ( -e $ROOT_DIRECTORY . $path_string ) {
        return 409, "'$path_string' already exists!";
    }

    my $parent = $path->to_dir->to_route;

    if ( not -e $ROOT_DIRECTORY . $parent ) {
        return 409, "Parent directory '$parent' does not exist!";
    }

    if ( not -d $ROOT_DIRECTORY . $parent ) {
        return 409, "Parent path '$parent' exists, but is not a directory!";
    }

    return 200, '';
}

sub check_user_can_delete_file ($user, $path) {
    my $path_string = $path->to_route;

    if ( not user_has_permission_on_path($user, 'DELETE', $path) ) {
        return 403, "You do not have permission to delete '$path_string'!";
    }

    if ( not -e $ROOT_DIRECTORY . $path_string ) {
        return 404, "'$path_string' does not exist!";
    }

    return 200, '';
}

sub check_dexter_can_edit_file ($path) {
    my $path_string = $path->to_route;

    if ( not -w $ROOT_DIRECTORY . $path_string ) {
        return 500, "Dexter cannot edit the file at '$path_string'!";
    }

    return 200, '';
}

sub check_dexter_can_create_file ($path) {
    my $path_string = $path->clone->trailing_slash(0)->to_dir->to_route;

    if ( not -w $ROOT_DIRECTORY . $path_string ) {
        return 500, "Dexter cannot create the file at '$path_string'!";
    }

    return 200, '';
}



if ( module_installed('OpenBSD::Unveil') ) {
    for my $directory (@INC) {
        unveil($directory, 'r');
    }

    unveil($TEMP_DIRECTORY, 'rw');
    unveil('/dev/null',  'rw');

    my ( undef, $parent_directory, undef ) = File::Spec->splitpath($0);

    unveil($parent_directory, 'r');
    unveil($ROOT_DIRECTORY,   'rwc');
    unveil($SOCKET_DIRECTORY, 'rwc');
    unveil();
}

push @{app->static->paths}, $ROOT_DIRECTORY;
app->max_request_size($MAX_REQUEST_SIZE);
app->start;