#!/usr/bin/perl
use strict;
use warnings;
use File::Path qw(remove_tree);

# ---------------------------------------------------------------------------
# Navigateur de fichiers + upload pour /var/www (dl.accessolutions.fr)
# - Place a la racine : /var/www/index.cgi
# - Execution restreinte au port 8088 (protege par mot de passe).
# - Navigation multi-dossiers via ?dir=  + fil d'Ariane.
# - Telechargements en URL absolue publique (port 443).
# - Upload (500 Mo max) et creation de dossier dans le dossier courant.
# CGI Perl pur (sans CGI.pm). Upload en streaming.
# ---------------------------------------------------------------------------

my $ROOT      = '/var/www';
my $DL_BASE   = 'https://dl.accessolutions.fr';   # port 443 public
my $SELF      = 'index.cgi';                       # nom du script deploye
my $MAX_BYTES = 500 * 1024 * 1024;                 # 500 Mo
my $CHUNK     = 65536;

# --- helpers ---------------------------------------------------------------

sub html_escape {
    my ($s) = @_;
    $s = '' unless defined $s;
    $s =~ s/&/&/g;
    $s =~ s/</&lt;/g;
    $s =~ s/>/&gt;/g;
    $s =~ s/"/&quot;/g;
    return $s;
}

sub url_encode {
    my ($s) = @_;
    $s = '' unless defined $s;
    $s =~ s/([^A-Za-z0-9._~-])/sprintf('%%%02X', ord($1))/ge;
    return $s;
}

sub url_decode {
    my ($s) = @_;
    $s = '' unless defined $s;
    $s =~ tr/+/ /;
    $s =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge;
    return $s;
}

sub human_size {
    my ($b) = @_;
    my @u = ('o', 'Ko', 'Mo', 'Go', 'To');
    my $i = 0;
    my $v = $b + 0;
    while ($v >= 1024 && $i < $#u) { $v /= 1024; $i++; }
    return $i == 0 ? sprintf('%d %s', $v, $u[$i]) : sprintf('%.1f %s', $v, $u[$i]);
}

sub fmt_date {
    my ($t) = @_;
    my @lt = localtime($t);
    return sprintf('%04d-%02d-%02d %02d:%02d',
        $lt[5] + 1900, $lt[4] + 1, $lt[3], $lt[2], $lt[1]);
}

# nettoie un nom de fichier ou de dossier (liste blanche, pas de chemin)
sub safe_name {
    my ($n) = @_;
    $n = '' unless defined $n;
    $n =~ s/\\/\//g;
    $n =~ s{^.*/}{};
    $n =~ s/[\x00-\x1f]//g;
    $n =~ s/[^A-Za-z0-9._ \-()\[\]]+/_/g;
    $n =~ s/^\.+//;
    $n = substr($n, 0, 200);
    return $n;
}

# transforme le parametre dir en liste de segments surs (anti path-traversal)
sub clean_segments {
    my ($raw) = @_;
    $raw = '' unless defined $raw;
    $raw = url_decode($raw);
    $raw =~ s/\\/\//g;
    my @out;
    for my $seg (split m{/}, $raw) {
        next if $seg eq '' || $seg eq '.' || $seg eq '..';
        $seg =~ s/[\x00-\x1f]//g;
        next if $seg eq '';
        push @out, $seg;
    }
    return @out;
}

# chemin relatif encode pour ?dir= (segments encodes, join /)
sub enc_rel {
    my (@segs) = @_;
    return join('/', map { url_encode($_) } @segs);
}

sub self_link {
    my (@segs) = @_;
    my $rel = enc_rel(@segs);
    return length($rel) ? "$SELF?dir=$rel" : "$SELF";
}

sub dl_url {
    my (@segs) = @_;
    return "$DL_BASE/" . join('/', map { url_encode($_) } @segs);
}

sub unique_path {
    my ($dir, $name) = @_;
    my $path = "$dir/$name";
    return $path unless -e $path;
    my ($base, $ext) = $name =~ /^(.*?)(\.[^.]*)?$/;
    $base = $name unless defined $base;
    $ext  = ''    unless defined $ext;
    my $i = 1;
    $i++ while -e "$dir/$base-$i$ext";
    return "$dir/$base-$i$ext";
}

sub redirect_msg {
    my ($rel_enc, $m) = @_;
    my $q = url_encode($m);
    my $loc = length($rel_enc) ? "$SELF?dir=$rel_enc&msg=$q" : "$SELF?msg=$q";
    print "Status: 303 See Other\r\n";
    print "Location: ./$loc\r\n";
    print "Content-Type: text/plain; charset=utf-8\r\n\r\n";
    print "$m\n";
}

# --- lecture du parametre dir ----------------------------------------------

sub current_segments {
    my $raw = '';
    if (defined $ENV{QUERY_STRING} && $ENV{QUERY_STRING} =~ /(?:^|&)dir=([^&]*)/) {
        $raw = $1;
    }
    return clean_segments($raw);
}

# --- tri des colonnes ------------------------------------------------------

# lit un parametre de tri depuis la query string, valide contre une liste
sub sort_param {
    my ($key, $default, @allowed) = @_;
    my $val = $default;
    if (defined $ENV{QUERY_STRING} && $ENV{QUERY_STRING} =~ /(?:^|&)\Q$key\E=([^&]*)/) {
        $val = url_decode($1);
    }
    my %ok = map { $_ => 1 } @allowed;
    return $ok{$val} ? $val : $default;
}

# genere une entete <th> triable qui preserve chemin + tri des deux tableaux
# $group : 'd' (dossiers) ou 'f' (fichiers)
sub th_sort {
    my ($segs_ref, $col, $label, $group, $dsort, $ddir, $fsort, $fdir) = @_;
    my ($cur_sort, $cur_dir) = $group eq 'd' ? ($dsort, $ddir) : ($fsort, $fdir);
    my $active = ($cur_sort eq $col);
    my $next   = ($active && $cur_dir eq 'asc') ? 'desc' : 'asc';
    my ($nds, $ndd, $nfs, $nfd) = ($dsort, $ddir, $fsort, $fdir);
    if ($group eq 'd') { $nds = $col; $ndd = $next; }
    else               { $nfs = $col; $nfd = $next; }
    my $rel = enc_rel(@$segs_ref);
    my $q   = "ds=$nds&amp;dd=$ndd&amp;fs=$nfs&amp;fd=$nfd";
    $q = "dir=$rel&amp;$q" if length $rel;
    my $href = "$SELF?$q";
    my $aria = $active ? ($cur_dir eq 'asc' ? 'ascending' : 'descending') : 'none';
    my $ind  = $active ? ($cur_dir eq 'asc' ? ' &#9650;' : ' &#9660;') : '';
    return sprintf('<th scope="col" aria-sort="%s"><a href="%s">%s%s</a></th>',
        $aria, $href, html_escape($label), $ind);
}

# --- page (GET) ------------------------------------------------------------

sub show_page {
    my (@segs) = current_segments();
    my $rel_enc = enc_rel(@segs);
    my $abs     = @segs ? "$ROOT/" . join('/', @segs) : $ROOT;

    my $msg = '';
    if (defined $ENV{QUERY_STRING} && $ENV{QUERY_STRING} =~ /(?:^|&)msg=([^&]*)/) {
        $msg = url_decode($1);
    }

    my (@dirs, @files);
    if (-d $abs && opendir(my $dh, $abs)) {
        while (my $e = readdir($dh)) {
            next if $e eq '.' || $e eq '..';
            next if $e =~ /^\./;                      # caches (.htpasswd, .htaccess...)
            next if !@segs && $e eq $SELF;            # masque le script a la racine
            my $path = "$abs/$e";
            if (-d $path) {
                my @st = stat($path);
                push @dirs, { name => $e, mtime => $st[9] };
            } elsif (-f $path) {
                my @st = stat($path);
                push @files, { name => $e, size => $st[7], mtime => $st[9] };
            }
        }
        closedir($dh);
    }
    # tri : defaut par nom croissant, bascule via les entetes de colonnes
    my $dsort = sort_param('ds', 'name', 'name', 'date');
    my $ddir  = sort_param('dd', 'asc',  'asc',  'desc');
    my $fsort = sort_param('fs', 'name', 'name', 'size', 'date');
    my $fdir  = sort_param('fd', 'asc',  'asc',  'desc');

    if ($dsort eq 'date') {
        @dirs = sort { $a->{mtime} <=> $b->{mtime} } @dirs;
    } else {
        @dirs = sort { lc($a->{name}) cmp lc($b->{name}) } @dirs;
    }
    @dirs = reverse @dirs if $ddir eq 'desc';

    if ($fsort eq 'size') {
        @files = sort { $a->{size} <=> $b->{size} } @files;
    } elsif ($fsort eq 'date') {
        @files = sort { $a->{mtime} <=> $b->{mtime} } @files;
    } else {
        @files = sort { lc($a->{name}) cmp lc($b->{name}) } @files;
    }
    @files = reverse @files if $fdir eq 'desc';

    my $writable = -d $abs && -w $abs;

    print "Content-Type: text/html; charset=utf-8\r\n\r\n";

    print <<'HEAD';
<!DOCTYPE html>
<html lang="fr">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>Fichiers dl.accessolutions.fr</title>
<style>
  body { font-family: Segoe UI, Arial, sans-serif; margin: 1.5rem; color: #1b1b1b; }
  h1 { font-size: 1.4rem; }
  h2 { font-size: 1.1rem; margin-top: 1.6rem; }
  nav.bc { font-size: 1rem; margin: .6rem 0 1rem; }
  nav.bc a { color: #0b5cad; text-decoration: none; }
  nav.bc a:hover { text-decoration: underline; }
  nav.bc .sep { color: #888; margin: 0 .3rem; }
  .tools { background: #f3f6fb; border: 1px solid #c9d6e5; border-radius: 8px;
           padding: 1rem; margin-bottom: 1.4rem; display: flex; flex-wrap: wrap;
           gap: 1.2rem; align-items: flex-end; }
  .tools form { margin: 0; }
  .tools label { display: block; font-weight: bold; margin-bottom: .3rem; }
  .tools input[type=file], .tools input[type=text] { font-size: 1rem; }
  .tools button { font-size: 1rem; padding: .5rem 1rem; margin-left: .4rem;
                  background: #0b5cad; color: #fff; border: 0; border-radius: 6px; cursor: pointer; }
  .tools button:hover { background: #094989; }
  .note { color: #555; font-size: .9rem; margin-top: .4rem; }
  .ro { background: #fdf3e6; border: 1px solid #e5c98f; color: #6b4e12;
        padding: .6rem .9rem; border-radius: 6px; margin-bottom: 1.4rem; }
  .msg { background: #e6f4ea; border: 1px solid #a8d5b5; color: #14532d;
         padding: .6rem .9rem; border-radius: 6px; margin-bottom: 1rem; }
  table { border-collapse: collapse; width: 100%; }
  th, td { text-align: left; padding: .5rem .7rem; border-bottom: 1px solid #e2e2e2; }
  th { background: #f0f0f0; }
  th a { color: #0b5cad; text-decoration: none; font-weight: bold; }
  th a:hover, th a:focus { text-decoration: underline; }
  tr:hover td { background: #fafafa; }
  td.size, td.date { white-space: nowrap; }
  a { color: #0b5cad; text-decoration: none; }
  a:hover { text-decoration: underline; }
  .empty { color: #777; font-style: italic; }
  td.chk, th.chk { width: 1.5rem; text-align: center; }
  td.act { white-space: nowrap; }
  button.del { background: #b3261e; color: #fff; border: 0; border-radius: 6px;
               padding: .3rem .7rem; font-size: .9rem; cursor: pointer; }
  button.del:hover { background: #8f1c16; }
  button.ren { background: #0b5cad; color: #fff; border: 0; border-radius: 6px;
               padding: .3rem .7rem; font-size: .9rem; cursor: pointer; }
  button.ren:hover { background: #094989; }
  .delbar { margin: .8rem 0 1.4rem; }
  .delbar button.del { padding: .5rem 1rem; font-size: 1rem; }
</style>
</head>
<body>
<h1>Fichiers dl.accessolutions.fr</h1>
HEAD

    # fil d'Ariane
    print "<nav class=\"bc\" aria-label=\"Fil d'Ariane\">";
    print "<a href=\"" . html_escape(self_link()) . "\">Racine</a>";
    my @cum;
    for my $seg (@segs) {
        push @cum, $seg;
        print "<span class=\"sep\">/</span>";
        print "<a href=\"" . html_escape(self_link(@cum)) . "\">" . html_escape($seg) . "</a>";
    }
    print "</nav>\n";

    if (length $msg) {
        print '<div class="msg" role="status">', html_escape($msg), "</div>\n";
    }

    if ($writable) {
        my $action = html_escape(self_link(@segs));
        print <<"TOOLS";
<div class="tools">
  <form method="post" enctype="multipart/form-data" action="$action">
    <label for="file">Envoyer un fichier</label>
    <input type="file" name="file" id="file" required autofocus>
    <button type="submit">Envoyer</button>
    <div class="note">Taille maximale : 500 Mo.</div>
  </form>
  <form method="post" action="$action">
    <input type="hidden" name="op" value="mkdir">
    <label for="newdir">Nouveau dossier</label>
    <input type="text" name="name" id="newdir" placeholder="Nom du dossier" required>
    <button type="submit">Creer</button>
  </form>
</div>
TOOLS
    } else {
        print "<div class=\"ro\">Ce dossier est en lecture seule : envoi de fichier et creation de dossier indisponibles ici.</div>\n";
    }

    # formulaire de renommage partage (dossiers + fichiers)
    if ($writable) {
        my $action = html_escape(self_link(@segs));
        print "<form id=\"renform\" method=\"post\" action=\"$action\" style=\"display:none\">\n";
        print "<input type=\"hidden\" name=\"op\" value=\"rename\">\n";
        print "<input type=\"hidden\" name=\"old\" value=\"\">\n";
        print "<input type=\"hidden\" name=\"new\" value=\"\">\n";
        print "</form>\n";
    }

    # dossiers
    print "<h2>Dossiers</h2>\n";
    if (!@dirs) {
        print "<p class=\"empty\">Aucun sous-dossier.</p>\n";
    } elsif ($writable) {
        my $action = html_escape(self_link(@segs));
        print "<form method=\"post\" action=\"$action\">\n";
        print "<input type=\"hidden\" name=\"op\" value=\"delete\">\n";
        print "<table>\n<thead><tr>";
        print "<th class=\"chk\"><input type=\"checkbox\" onclick=\"toggleAll(this, 'seldir')\" title=\"Tout cocher\" aria-label=\"Tout cocher les dossiers\"></th>";
        print th_sort(\@segs, 'name', 'Nom', 'd', $dsort, $ddir, $fsort, $fdir);
        print th_sort(\@segs, 'date', 'Modifie le', 'd', $dsort, $ddir, $fsort, $fdir);
        print "<th>Actions</th></tr></thead>\n<tbody>\n";
        for my $d (@dirs) {
            my $link = html_escape(self_link(@segs, $d->{name}));
            my $disp = html_escape($d->{name});
            my $val  = html_escape($d->{name});
            printf "<tr class=\"dir\"><td class=\"chk\"><input type=\"checkbox\" name=\"seldir\" value=\"%s\" aria-label=\"%s\"></td><td><a href=\"%s\">%s</a></td><td class=\"date\">%s</td><td class=\"act\"><button type=\"button\" class=\"ren\" data-name=\"%s\" onclick=\"renameItem(this)\">Renommer</button> <button type=\"submit\" name=\"deldir\" value=\"%s\" class=\"del\" onclick=\"return confirm('Supprimer ce dossier et tout son contenu ?')\">Supprimer</button></td></tr>\n",
                $val, $disp, $link, $disp, fmt_date($d->{mtime}), $val, $val;
        }
        print "</tbody>\n</table>\n";
        print "<div class=\"delbar\"><button type=\"submit\" class=\"del\" onclick=\"return confirmSel('seldir', 'dossier')\">Supprimer les dossiers selectionnes</button></div>\n";
        print "</form>\n";
    } else {
        print "<table>\n<thead><tr>";
        print th_sort(\@segs, 'name', 'Nom', 'd', $dsort, $ddir, $fsort, $fdir);
        print th_sort(\@segs, 'date', 'Modifie le', 'd', $dsort, $ddir, $fsort, $fdir);
        print "</tr></thead>\n<tbody>\n";
        for my $d (@dirs) {
            my $link = html_escape(self_link(@segs, $d->{name}));
            my $disp = html_escape($d->{name});
            printf "<tr class=\"dir\"><td><a href=\"%s\">%s</a></td><td class=\"date\">%s</td></tr>\n",
                $link, $disp, fmt_date($d->{mtime});
        }
        print "</tbody>\n</table>\n";
    }

    # fichiers
    print "<h2>Fichiers</h2>\n";
    if (!@files) {
        print "<p class=\"empty\">Aucun fichier dans ce dossier.</p>\n";
    } elsif ($writable) {
        my $action = html_escape(self_link(@segs));
        print "<form method=\"post\" action=\"$action\">\n";
        print "<input type=\"hidden\" name=\"op\" value=\"delete\">\n";
        print "<table>\n<thead><tr>";
        print "<th class=\"chk\"><input type=\"checkbox\" onclick=\"toggleAll(this, 'sel')\" title=\"Tout cocher\" aria-label=\"Tout cocher les fichiers\"></th>";
        print th_sort(\@segs, 'name', 'Nom', 'f', $dsort, $ddir, $fsort, $fdir);
        print th_sort(\@segs, 'size', 'Taille', 'f', $dsort, $ddir, $fsort, $fdir);
        print th_sort(\@segs, 'date', 'Date', 'f', $dsort, $ddir, $fsort, $fdir);
        print "<th>Actions</th></tr></thead>\n<tbody>\n";
        for my $f (@files) {
            my $url  = html_escape(dl_url(@segs, $f->{name}));
            my $disp = html_escape($f->{name});
            my $val  = html_escape($f->{name});
            printf "<tr><td class=\"chk\"><input type=\"checkbox\" name=\"sel\" value=\"%s\" aria-label=\"%s\"></td><td><a href=\"%s\">%s</a></td><td class=\"size\">%s</td><td class=\"date\">%s</td><td class=\"act\"><button type=\"button\" class=\"ren\" data-name=\"%s\" onclick=\"renameItem(this)\">Renommer</button> <button type=\"submit\" name=\"del\" value=\"%s\" class=\"del\" onclick=\"return confirm('Supprimer ce fichier ?')\">Supprimer</button></td></tr>\n",
                $val, $disp, $url, $disp, human_size($f->{size}), fmt_date($f->{mtime}), $val, $val;
        }
        print "</tbody>\n</table>\n";
        print "<div class=\"delbar\"><button type=\"submit\" class=\"del\" onclick=\"return confirmSel('sel', 'fichier')\">Supprimer la selection</button></div>\n";
        print "</form>\n";
    } else {
        print "<table>\n<thead><tr>";
        print th_sort(\@segs, 'name', 'Nom', 'f', $dsort, $ddir, $fsort, $fdir);
        print th_sort(\@segs, 'size', 'Taille', 'f', $dsort, $ddir, $fsort, $fdir);
        print th_sort(\@segs, 'date', 'Date', 'f', $dsort, $ddir, $fsort, $fdir);
        print "</tr></thead>\n<tbody>\n";
        for my $f (@files) {
            my $url  = html_escape(dl_url(@segs, $f->{name}));
            my $disp = html_escape($f->{name});
            printf "<tr><td><a href=\"%s\">%s</a></td><td class=\"size\">%s</td><td class=\"date\">%s</td></tr>\n",
                $url, $disp, human_size($f->{size}), fmt_date($f->{mtime});
        }
        print "</tbody>\n</table>\n";
    }

    print <<'FOOT';
<script>
  var f = document.getElementById('file');
  if (f) { f.focus(); }
  function toggleAll(src, name) {
    var boxes = document.getElementsByName(name);
    for (var i = 0; i < boxes.length; i++) { boxes[i].checked = src.checked; }
  }
  function confirmSel(name, label) {
    var boxes = document.getElementsByName(name);
    var n = 0;
    for (var i = 0; i < boxes.length; i++) { if (boxes[i].checked) n++; }
    if (n === 0) { alert('Aucun ' + label + ' selectionne.'); return false; }
    return confirm('Supprimer ' + n + ' ' + label + '(s) selectionne(s) ?');
  }
  function renameItem(btn) {
    var oldName = btn.getAttribute('data-name');
    var nn = prompt('Nouveau nom pour :\n' + oldName, oldName);
    if (nn === null) { return; }
    nn = nn.replace(/^\s+|\s+$/g, '');
    if (nn === '' || nn === oldName) { return; }
    var frm = document.getElementById('renform');
    frm.elements['old'].value = oldName;
    frm.elements['new'].value = nn;
    frm.submit();
  }
</script>
</body>
</html>
FOOT
}

# --- lecture d'un corps POST urlencoded (multi-valeurs) --------------------

sub parse_post_form {
    my $clen = $ENV{CONTENT_LENGTH} || 0;
    my %h;
    return \%h if $clen <= 0 || $clen > 1024 * 256;
    my $body = '';
    read(STDIN, $body, $clen);
    for my $pair (split /&/, $body) {
        my ($k, $v) = split /=/, $pair, 2;
        next unless defined $k;
        $k = url_decode($k);
        $v = defined $v ? url_decode($v) : '';
        push @{ $h{$k} }, $v;
    }
    return \%h;
}

# --- creation de dossier (POST urlencoded) ---------------------------------

sub handle_mkdir {
    my ($segs_ref, $rel_enc, $form) = @_;
    my @segs = @$segs_ref;
    my $abs  = @segs ? "$ROOT/" . join('/', @segs) : $ROOT;

    my $name = safe_name($form->{name} ? $form->{name}[0] : '');
    if ($name eq '') { redirect_msg($rel_enc, 'Nom de dossier invalide.'); return; }

    unless (-d $abs && -w $abs) {
        redirect_msg($rel_enc, 'Creation impossible : dossier en lecture seule.');
        return;
    }
    my $target = "$abs/$name";
    if (-e $target) {
        redirect_msg($rel_enc, "Impossible : un nom identique existe deja ($name).");
        return;
    }
    if (mkdir($target, 0775)) {
        redirect_msg($rel_enc, "Dossier cree : $name");
    } else {
        redirect_msg($rel_enc, "Echec de creation du dossier.");
    }
}

# --- suppression fichiers / dossiers (POST urlencoded) ---------------------

sub handle_delete {
    my ($segs_ref, $rel_enc, $form) = @_;
    my @segs = @$segs_ref;
    my $abs  = @segs ? "$ROOT/" . join('/', @segs) : $ROOT;

    unless (-d $abs && -w $abs) {
        redirect_msg($rel_enc, 'Suppression impossible : dossier en lecture seule.');
        return;
    }

    my (%files, %dirs);
    for my $key ('del', 'sel') {
        next unless $form->{$key};
        for my $n (@{ $form->{$key} }) { my $s = safe_name($n); $files{$s} = 1 if $s ne ''; }
    }
    for my $key ('deldir', 'seldir') {
        next unless $form->{$key};
        for my $n (@{ $form->{$key} }) { my $s = safe_name($n); $dirs{$s} = 1 if $s ne ''; }
    }

    my $done = 0;
    my $fail = 0;
    for my $n (keys %files) {
        my $p = "$abs/$n";
        if (-f $p && unlink($p)) { $done++; } else { $fail++; }
    }
    for my $n (keys %dirs) {
        my $p = "$abs/$n";
        if (-d $p) {
            my $removed = remove_tree($p, { safe => 1 });
            if ($removed && !-e $p) { $done++; } else { $fail++; }
        } else {
            $fail++;
        }
    }

    if (!$done && !$fail) {
        redirect_msg($rel_enc, 'Aucun element selectionne.');
    } elsif ($fail) {
        redirect_msg($rel_enc, "Supprime : $done. Echecs : $fail.");
    } else {
        redirect_msg($rel_enc, "Element(s) supprime(s) : $done.");
    }
}

# --- renommage fichier / dossier (POST urlencoded) -------------------------

sub handle_rename {
    my ($segs_ref, $rel_enc, $form) = @_;
    my @segs = @$segs_ref;
    my $abs  = @segs ? "$ROOT/" . join('/', @segs) : $ROOT;

    unless (-d $abs && -w $abs) {
        redirect_msg($rel_enc, 'Renommage impossible : dossier en lecture seule.');
        return;
    }

    my $old = safe_name($form->{old} ? $form->{old}[0] : '');
    my $new = safe_name($form->{new} ? $form->{new}[0] : '');
    if ($old eq '' || $new eq '') { redirect_msg($rel_enc, 'Nom invalide.'); return; }

    my $src = "$abs/$old";
    my $dst = "$abs/$new";
    unless (-e $src) { redirect_msg($rel_enc, "Introuvable : $old"); return; }
    if ($old eq $new) { redirect_msg($rel_enc, 'Le nom est inchange.'); return; }
    if (-e $dst) {
        redirect_msg($rel_enc, "Impossible : un nom identique existe deja ($new).");
        return;
    }
    if (rename($src, $dst)) {
        redirect_msg($rel_enc, "Renomme : $old -> $new");
    } else {
        redirect_msg($rel_enc, 'Echec du renommage.');
    }
}

# --- upload (POST multipart) -----------------------------------------------

sub handle_upload {
    my ($segs_ref, $rel_enc) = @_;
    my @segs = @$segs_ref;
    my $abs  = @segs ? "$ROOT/" . join('/', @segs) : $ROOT;

    unless (-d $abs && -w $abs) {
        redirect_msg($rel_enc, 'Envoi impossible : dossier en lecture seule.');
        return;
    }

    my $ctype = $ENV{CONTENT_TYPE}   || '';
    my $clen  = $ENV{CONTENT_LENGTH} || 0;

    if ($clen > $MAX_BYTES + 1024 * 1024) {
        redirect_msg($rel_enc, 'Fichier trop volumineux (max 500 Mo).');
        return;
    }
    my ($boundary) = $ctype =~ /boundary="?([^";]+)"?/i;
    unless (defined $boundary && length $boundary) {
        redirect_msg($rel_enc, 'Limite MIME introuvable.');
        return;
    }

    binmode(STDIN);
    my $dash_boundary = "--$boundary";
    my $delim         = "\r\n--$boundary";
    my $buf           = '';
    my $eof           = 0;

    my $read_more = sub {
        return 0 if $eof;
        my $tmp;
        my $n = read(STDIN, $tmp, $CHUNK);
        if (!defined $n || $n == 0) { $eof = 1; return 0; }
        $buf .= $tmp;
        return $n;
    };

    while (index($buf, $dash_boundary) < 0) {
        last unless $read_more->();
    }
    my $bp = index($buf, $dash_boundary);
    if ($bp < 0) { redirect_msg($rel_enc, 'Envoi invalide.'); return; }
    $buf = substr($buf, $bp + length($dash_boundary));

    my $saved_name;

    PART: while (1) {
        while (length($buf) < 2) { last unless $read_more->(); }
        last PART if length($buf) >= 2 && substr($buf, 0, 2) eq '--';
        $buf =~ s/^\r\n//;

        while (index($buf, "\r\n\r\n") < 0) {
            last unless $read_more->();
        }
        my $hend = index($buf, "\r\n\r\n");
        last PART if $hend < 0;
        my $headers = substr($buf, 0, $hend);
        $buf = substr($buf, $hend + 4);

        my $fn;
        if ($headers =~ /Content-Disposition:.*?filename="([^"]*)"/is) {
            $fn = $1;
        } elsif ($headers =~ /Content-Disposition:.*?filename=([^\r\n;]+)/is) {
            $fn = $1;
        }
        my $is_file = defined $fn && length $fn;

        if ($is_file) {
            my $target = unique_path($abs, safe_name($fn));
            my $out_fh;
            unless (open($out_fh, '>', $target)) {
                redirect_msg($rel_enc, 'Ecriture impossible sur le serveur.');
                return;
            }
            binmode($out_fh);
            my $written = 0;
            my $too_big = 0;

            while (1) {
                my $dpos = index($buf, $delim);
                if ($dpos >= 0) {
                    if ($dpos > 0) {
                        $written += $dpos;
                        $too_big = 1 if $written > $MAX_BYTES;
                        print $out_fh substr($buf, 0, $dpos) unless $too_big;
                    }
                    $buf = substr($buf, $dpos + length($delim));
                    last;
                }
                my $keep = length($delim) - 1;
                if (length($buf) > $keep) {
                    my $wlen = length($buf) - $keep;
                    my $data = substr($buf, 0, $wlen);
                    $buf = substr($buf, $wlen);
                    $written += length($data);
                    $too_big = 1 if $written > $MAX_BYTES;
                    print $out_fh $data unless $too_big;
                }
                unless ($read_more->()) {
                    $written += length($buf);
                    $too_big = 1 if $written > $MAX_BYTES;
                    print $out_fh $buf unless $too_big;
                    $buf = '';
                    last;
                }
            }
            close($out_fh);

            if ($too_big) {
                unlink($target);
                1 while read(STDIN, my $drain, $CHUNK);
                redirect_msg($rel_enc, 'Fichier trop volumineux (max 500 Mo).');
                return;
            }
            ($saved_name) = $target =~ m{([^/]+)$};
            next PART;
        }

        while (1) {
            my $dpos = index($buf, $delim);
            if ($dpos >= 0) { $buf = substr($buf, $dpos + length($delim)); last; }
            my $keep = length($delim) - 1;
            $buf = substr($buf, length($buf) - $keep) if length($buf) > $keep;
            last unless $read_more->();
        }
    }

    # vider le reste de STDIN pour eviter un broken pipe cote Apache
    1 while read(STDIN, my $drain, $CHUNK);

    if (defined $saved_name && length $saved_name) {
        redirect_msg($rel_enc, "Fichier envoye : $saved_name");
    } else {
        redirect_msg($rel_enc, 'Aucun fichier selectionne.');
    }
}

# --- dispatch --------------------------------------------------------------

my $method = $ENV{REQUEST_METHOD} || 'GET';
if ($method eq 'POST') {
    my @segs = current_segments();
    my $rel_enc = enc_rel(@segs);
    my $ctype = $ENV{CONTENT_TYPE} || '';
    if ($ctype =~ m{multipart/form-data}i) {
        handle_upload(\@segs, $rel_enc);
    } else {
        my $form = parse_post_form();
        my $op = $form->{op} ? $form->{op}[0] : '';
        if    ($op eq 'delete') { handle_delete(\@segs, $rel_enc, $form); }
        elsif ($op eq 'rename') { handle_rename(\@segs, $rel_enc, $form); }
        else                    { handle_mkdir(\@segs, $rel_enc, $form); }
    }
} else {
    show_page();
}