forked from hummypkg/webif
944 lines
21 KiB
Plaintext
Executable File
944 lines
21 KiB
Plaintext
Executable File
#!/mod/bin/jimsh
|
|
|
|
source /mod/webif/lib/setup
|
|
require lock system.class ts.class pretty_size browse.class \
|
|
safe_delete settings.class plugin queue.class rsv.class
|
|
|
|
set settings [settings]
|
|
set loglevel [$settings autolog]
|
|
set audiomp3 [$settings audiomp3]
|
|
|
|
set modules {decrypt dedup shrink mpg mp3 expire}
|
|
|
|
set queue_actions {
|
|
decrypt do_decrypt
|
|
strip do_shrink
|
|
shrink do_shrink
|
|
mpg do_mpg
|
|
mp3 do_mp3
|
|
}
|
|
|
|
set root [system mediaroot]
|
|
|
|
set logfile "/mod/tmp/auto.log"
|
|
|
|
set logfd "unset"
|
|
set logprefix ""
|
|
set prelocked 0
|
|
set earlyexit 0
|
|
while {[llength $argv]} {
|
|
switch -- [lindex $argv 0] {
|
|
-d {
|
|
set loglevel 2
|
|
set logfd stdout
|
|
}
|
|
-prelocked {
|
|
set prelocked 1
|
|
}
|
|
-logprefix {
|
|
set argv [lrange $argv 1 end]
|
|
if {[llength $argv]} {
|
|
set logprefix [lindex $argv 0]
|
|
}
|
|
}
|
|
-test {
|
|
set earlyexit 1
|
|
}
|
|
default {
|
|
# Unknown option, pass to rest of script.
|
|
break
|
|
}
|
|
}
|
|
set argv [lrange $argv 1 end]
|
|
}
|
|
|
|
#########################################################################
|
|
|
|
if {$logfd ne "unset"} {
|
|
puts $logfd "Acquiring lock..."
|
|
}
|
|
if {!$prelocked && ![acquire_lock webif_auto 10 1]} {
|
|
if {$loglevel > 1} {
|
|
system plog auto "Could not acquire lock."
|
|
}
|
|
puts "Could not acquire exclusive lock, terminating."
|
|
exit
|
|
}
|
|
|
|
# Rotate log file if large enough.
|
|
if {[file exists $logfile] && [file size $logfile] > 2097152} {
|
|
file copy -force $logfile "/mod/tmp/auto_old.log"
|
|
file delete $logfile
|
|
}
|
|
|
|
if {$logfd eq "unset"} {
|
|
set logfd [open "/mod/tmp/auto.log" "a+"]
|
|
}
|
|
|
|
proc log {msg {level 1}} {
|
|
if {$level > $::loglevel} return
|
|
puts $::logfd "[system logtimestamp] - $::logprefix$msg"
|
|
flush $::logfd
|
|
}
|
|
|
|
proc oktorun {} {
|
|
global settings
|
|
set now [clock seconds]
|
|
|
|
# Ongoing scheduled recording
|
|
if {[$settings noautorec]} {
|
|
# Use redring helper files if available.
|
|
set recs [glob -nocomplain /tmp/.rec*]
|
|
set events [rsv list tbl_reservation \
|
|
" where ersvtype = 3
|
|
and nsttime - ulPreOffset <= $now
|
|
and nsttime + nduration + ulPostOffset >= $now "]
|
|
if {[llength $recs] || [llength $events]} {
|
|
log "Aborted, recording in progress." 2
|
|
exit
|
|
}
|
|
}
|
|
|
|
# Imminent recording
|
|
if {[$settings noautorecimm]} {
|
|
set autorecperiod $([$settings autorecperiod] * 60)
|
|
set events [rsv list tbl_reservation \
|
|
" where ersvtype = 3
|
|
and nsttime - $now < $autorecperiod
|
|
and nsttime > $now "]
|
|
if {[llength $events]} {
|
|
set event [lindex $events 0]
|
|
log [concat \
|
|
"Aborted, will record '[$event name]' " \
|
|
"on [$event channel_name] at " \
|
|
"[clock format [$event get nsttime] -format {%H:%M}]" \
|
|
] 2
|
|
exit
|
|
}
|
|
}
|
|
|
|
# Non-running hours
|
|
set hour $([clock format [clock seconds] -format %H] + 0)
|
|
if {$hour in [$settings noautohours]} {
|
|
log "Aborted, not running during hour $hour" 2
|
|
exit
|
|
}
|
|
}
|
|
|
|
proc inuse {ts} {
|
|
set retries 5
|
|
while {$retries > 0 && [$ts inuse]} {
|
|
log "inuse($retries) - [$ts get file]"
|
|
incr retries -1
|
|
sleep 1
|
|
}
|
|
return [$ts inuse]
|
|
}
|
|
|
|
proc specialdir {dir} {
|
|
if {[string match {\[*} [string trimleft [file tail $dir]]]} {
|
|
return 1
|
|
}
|
|
return 0
|
|
}
|
|
|
|
proc elapsed {start} {
|
|
return $(([clock milliseconds] - $start) / 1000.0)
|
|
}
|
|
|
|
proc startclock {} {
|
|
set ::startclock_s [clock milliseconds]
|
|
}
|
|
|
|
proc endclock {size} {
|
|
set el [elapsed $::startclock_s]
|
|
set rate $($size / $el)
|
|
return "[pretty_size $size] in $el seconds - [pretty_size $rate]/s"
|
|
}
|
|
|
|
foreach mod $modules {
|
|
set "hook_pre${mod}scan" {}
|
|
set "hook_pre$mod" {}
|
|
set "hook_post$mod" {}
|
|
set "hook_post${mod}scan" {}
|
|
set "hook_pre${mod}singledir" {}
|
|
set "hook_post${mod}singledir" {}
|
|
}
|
|
|
|
proc register {type fn {priority 50}} {
|
|
global "hook_$type"
|
|
if {[info exists "hook_$type"]} {
|
|
lappend "hook_$type" [list $fn $priority]
|
|
log "Registered $fn for $type hook with priority $priority."
|
|
} else {
|
|
log "Unknown hook hook_$type" 0
|
|
}
|
|
}
|
|
|
|
proc register_queue {action function} {
|
|
set ::queue_actions($action) $function
|
|
}
|
|
|
|
proc runplugin {name {ts 0}} {
|
|
set var "hook_$name"
|
|
global $var
|
|
foreach p [lsort -index end -decreasing -integer [subst $$var]] {
|
|
lassign $p fn priority
|
|
log "Running $name plugin $fn (priority $priority) \[$ts]" 2
|
|
if {[catch {uplevel 1 [list $fn $ts]} msg]} {
|
|
log "Plugin error: $msg" 0
|
|
foreach {proc file line} [info stacktrace] {
|
|
log " @ $file:$proc:$line" 0
|
|
}
|
|
}
|
|
log "Completed $name plugin $fn" 2
|
|
}
|
|
}
|
|
|
|
# Check if it's ok to run now.
|
|
oktorun
|
|
|
|
if {$earlyexit} {
|
|
puts "Early exit."
|
|
exit
|
|
}
|
|
|
|
eval_plugins auto 1
|
|
|
|
set scanstart [clock milliseconds]
|
|
log "-------------------------------------------------------"
|
|
|
|
# dlnastatus is relatively expensive so it is checked once globally at
|
|
# the start and then if the server is not listening then no decrypt
|
|
# operations will be attempted for this run, even if the server starts
|
|
# up halfway through. Otherwise the server is checked for every decryption
|
|
# and if it goes away then decryption will not be attempted for the rest
|
|
# of the run.
|
|
if {[system dlnastatus]} {
|
|
set dlnaok 1
|
|
log "DLNA Server is running." 2
|
|
} else {
|
|
set dlnaok 0
|
|
log "DLNA Server is NOT running." 2
|
|
}
|
|
|
|
log "Media scan starting, DLNA server status: $dlnaok"
|
|
|
|
proc dsc {{size 0}} {
|
|
set free [system diskfree]
|
|
|
|
# Required disk space is 1GiB + 3 times the file size.
|
|
set req $($size * 3 + 1073741824)
|
|
|
|
if {$free < $req} {
|
|
log "Insufficient disk space. Require=$req, Free=$free" 0
|
|
exit
|
|
}
|
|
}
|
|
|
|
dsc
|
|
|
|
set tmp "/mod/tmp/webif_auto"
|
|
if {![file exists $tmp]} {
|
|
if {[catch {file mkdir $tmp} msg]} {
|
|
log "Cannot create temporary directory - $tmp ($msg)" 0
|
|
exit
|
|
}
|
|
} elseif {![file isdirectory $tmp]} {
|
|
log "Cannot create temporary directory - $tmp (file exists)" 0
|
|
exit
|
|
}
|
|
|
|
# Clean-up the temporary directory
|
|
foreach file [readdir -nocomplain $tmp] { file tdelete "$tmp/$file" }
|
|
|
|
if {[system pkginst undelete]} {
|
|
set dustbin "[system dustbin]"
|
|
} else {
|
|
set dustbin ""
|
|
}
|
|
|
|
log "Dustbin: $dustbin" 2
|
|
|
|
set recalc 0
|
|
|
|
proc dorecalc {dir} {
|
|
global recalc
|
|
if {!$recalc} return
|
|
log "Running unwatched recalculation for $dir" 2
|
|
ts resetnew $dir
|
|
incr recalc -1
|
|
}
|
|
|
|
proc dedup {dir {flag ""}} {
|
|
log "DEDUP: \[$dir]" 2
|
|
loop i 0 1 {
|
|
foreach line [split \
|
|
[exec /mod/webif/html/dedup/dedup -yes -auto $dir] "\n"] {
|
|
log $line 2
|
|
}
|
|
}
|
|
incr ::recalc
|
|
}
|
|
|
|
proc do_shrink {ts} {
|
|
global tmp dustbin tsgroup processed_files
|
|
set file [$ts get file]
|
|
|
|
if {[$ts flag "Shrunk"]} {
|
|
log " $file - already shrunk." 2
|
|
return
|
|
}
|
|
|
|
# If the directory is flagged for decryption as well as shrink
|
|
# then check to see if decryption has already occured. If not,
|
|
# defer the shrink for now.
|
|
set dir [file dirname $file]
|
|
if {[file exists "$dir/.autodecrypt"] || [scanup $dir decrypt] == 1} {
|
|
log " $dir is also set for decryption." 2
|
|
if {[$ts flag "ODEncrypted"]} {
|
|
log " $file - deferring shrink until decrypted."
|
|
return
|
|
}
|
|
}
|
|
|
|
set file [file rootname [$ts get file]]
|
|
|
|
if {[inuse $ts]} {
|
|
log " $file - in use." 2
|
|
return
|
|
}
|
|
|
|
if {[catch {
|
|
set perc [exec /mod/bin/stripts -aq $file]
|
|
} msg]} {
|
|
log " Error: $msg" 0
|
|
return
|
|
}
|
|
if {[string match {*%} $perc]} {
|
|
set perc [string range $perc 0 end-1]
|
|
} else {
|
|
set perc 0
|
|
}
|
|
|
|
if {$perc == 0} {
|
|
log " $file - already shrunk." 2
|
|
$ts set_shrunk
|
|
return
|
|
}
|
|
oktorun
|
|
set size [$ts size]
|
|
dsc $size
|
|
system startop shrink [$ts get file]
|
|
runplugin preshrink $ts
|
|
startclock
|
|
log " SHRINK: $file" 0
|
|
log " Estimate $perc% saving." 0
|
|
log " Shrinking..." 0
|
|
if {[catch {
|
|
foreach line [split \
|
|
[exec nice -n 19 /mod/bin/stripts -q $file $tmp/shrunk] \
|
|
"\n"] {
|
|
log $line 0
|
|
}
|
|
} msg]} {
|
|
log "Error during shrink: $msg" 0
|
|
system notify "$file - auto-shrink - error $msg."
|
|
system endop shrink
|
|
return
|
|
}
|
|
|
|
# The following steps are structured to minimise the risk of
|
|
# things being left in an inconsistent state if the system goes
|
|
# into standby. Renames within the same filesystem are very
|
|
# quick so the risk is small, but even so...
|
|
|
|
# Move the shrunken version back to the local directory.
|
|
foreach f [glob "$tmp/shrunk.*"] {
|
|
set ext [file extension $f]
|
|
file rename $f "${file}_shrunk${ext}"
|
|
# Set the file time to match the old file
|
|
file touch "${file}_shrunk${ext}" [$ts get file]
|
|
}
|
|
|
|
# Remove the old recording (-> bin if undelete is installed)
|
|
safe_delete [$ts get file] "webif_autoshrink"
|
|
|
|
# Finally, rename the shrunken recording again.
|
|
foreach ext $tsgroup {
|
|
set f "${file}_shrunk.$ext"
|
|
if {[file exists $f]} {
|
|
file rename $f "${file}.$ext"
|
|
}
|
|
}
|
|
$ts set_shrunk
|
|
log "Done... [endclock $size]" 0
|
|
lappend processed_files [$ts get file]
|
|
runplugin postshrink $ts
|
|
system endop shrink
|
|
}
|
|
|
|
proc do_decrypt {ts} {
|
|
global tmp dustbin processed_files
|
|
|
|
set file [$ts get file]
|
|
set rfile [file rootname $file]
|
|
set bfile [file tail $file]
|
|
|
|
if {![$ts flag "ODEncrypted"]} {
|
|
log " $file - Already decrypted." 2
|
|
return
|
|
}
|
|
|
|
if {[$ts flag "Encrypted"]} {
|
|
log " $file - Protected (Enc flag)." 2
|
|
return
|
|
}
|
|
|
|
if {![system dlnastatus]} {
|
|
log " $file - DLNA Server not running." 2
|
|
set ::dlnaok 0
|
|
return
|
|
}
|
|
|
|
if {[inuse $ts]} {
|
|
log " $file - In use."
|
|
return
|
|
}
|
|
|
|
# Check that the file is not already decrypted by analysing it.
|
|
set anencd [exec /mod/bin/stripts -qE $rfile]
|
|
if {$anencd != "1"} {
|
|
log " $file - already decrypted but the HMT flag is wrong." 0
|
|
# Fix...
|
|
exec /mod/webif/lib/bin/fixencflags $file
|
|
return
|
|
}
|
|
|
|
lassign [$ts dlnaloc "127.0.0.1"] url
|
|
if {$url ne ""} {
|
|
log " $file - has been indexed."
|
|
set helper 0
|
|
} else {
|
|
log " $file - Not yet indexed, trying helper."
|
|
if {[catch {
|
|
lassign [system dlnahelper [file normalize $file]] url
|
|
} msg]} {
|
|
log " $file - $msg"
|
|
}
|
|
if {$url eq ""} {
|
|
log " $file - Can't use helper."
|
|
return
|
|
}
|
|
set helper 1
|
|
}
|
|
|
|
# Perform the decryption by requesting the file from the DLNA server.
|
|
oktorun
|
|
set size [$ts size]
|
|
dsc $size
|
|
runplugin predecrypt $ts
|
|
system startop decrypt $file
|
|
startclock
|
|
log " DECRYPT: $rfile" 0
|
|
log " DLNA: $url" 0
|
|
exec wget -O "$tmp/$bfile" $url
|
|
|
|
# Release the helper lock once finished.
|
|
if {$helper} { system dlnahelper -release }
|
|
|
|
if {[file size $file] != [file size "$tmp/$bfile"]} {
|
|
log " $file - File size mismatch." 0
|
|
file tdelete "$tmp/$bfile"
|
|
system endop decrypt
|
|
return
|
|
}
|
|
|
|
# Check if the file is in use. It is possible that the file is
|
|
# now being played even though it was free when decryption started.
|
|
if {[inuse $ts]} {
|
|
log " $file - In use."
|
|
file tdelete "$tmp/$bfile"
|
|
system endop decrypt
|
|
return
|
|
}
|
|
|
|
# Copy the HMT file over for stripts
|
|
set thmt "$tmp/[file rootname $bfile].hmt"
|
|
file copy "$rfile.hmt" $thmt
|
|
# Check that the file is no longer encrypted by analysing it.
|
|
set anencd [exec /mod/bin/stripts -qE "$tmp/[file rootname $bfile]"]
|
|
file delete $thmt
|
|
|
|
if {$anencd != "0"} {
|
|
log " $file - File did not decrypt properly." 0
|
|
file tdelete "$tmp/$bfile"
|
|
if {[clock seconds] - [$ts get end] > 3 * 3600} {
|
|
system notify "$file - auto-decrypt failed."
|
|
}
|
|
system endop decrypt
|
|
return
|
|
}
|
|
|
|
# Move the encrypted file out of the way.
|
|
file rename $file "$rfile.encrypted"
|
|
# Move the decrypted copy into place.
|
|
file rename "$tmp/$bfile" $file
|
|
# Set the file time to match the old file
|
|
file touch $file "$rfile.encrypted"
|
|
# Patch the HMT - quickest way to get back to a playable file.
|
|
exec /mod/bin/hmt -encrypted "$rfile.hmt"
|
|
|
|
log " Removing/binning old copy." 0
|
|
# Move the old recording to the bin if undelete is installed.
|
|
if {$dustbin ne ""} {
|
|
set bin [_del_bindir $file "webif_autodecrypt"]
|
|
set tail [file tail $rfile]
|
|
file rename "$rfile.encrypted" "$bin/$tail.ts"
|
|
foreach ext {nts hmt thm} {
|
|
if {[file exists "$rfile.$ext"]} {
|
|
file copy $rfile.$ext "$bin/$tail.$ext"
|
|
if {$ext eq "hmt"} {
|
|
# Patch the binned HMT back
|
|
exec /mod/bin/hmt +encrypted \
|
|
"$bin/$tail.hmt"
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
file tdelete "$rfile.encrypted"
|
|
}
|
|
log "Done... [endclock $size]" 0
|
|
lappend processed_files [$ts get file]
|
|
$ts unflag "ODEncrypted"
|
|
runplugin postdecrypt $ts
|
|
system endop decrypt
|
|
}
|
|
|
|
proc do_mpg {ts} {
|
|
global tmp tsgroup processed_files
|
|
|
|
set file [file rootname [$ts get file]]
|
|
|
|
if {[file exists $file.mpg]} {
|
|
# Already done.
|
|
return
|
|
}
|
|
|
|
if {[$ts flag "ODEncrypted"]} {
|
|
log " $file - Not decrypted." 2
|
|
return
|
|
}
|
|
|
|
if {[$ts get definition] eq "HD"} {
|
|
# Cannot extract a useful MPG from a HD recording.
|
|
return
|
|
}
|
|
|
|
if {[inuse $ts]} {
|
|
log " $file - In use."
|
|
return
|
|
}
|
|
oktorun
|
|
system startop mpg [$ts get file]
|
|
runplugin prempg $ts
|
|
dsc [$ts size]
|
|
|
|
log " MPG: $file" 0
|
|
log " Converting..." 0
|
|
if {[catch {
|
|
foreach line [split \
|
|
[exec nice -n 19 /mod/bin/ffmpeg -y -benchmark -v 0 \
|
|
-i $file.ts \
|
|
-map 0:0 -map 0:1 \
|
|
-vcodec copy -acodec copy $tmp/mpg.mpg] "\n"] {
|
|
log $line 0
|
|
}
|
|
} msg]} {
|
|
log "Error during mpg extract: $msg" 0
|
|
system notify "$file - auto-mpg - error $msg."
|
|
system endop mpg
|
|
return
|
|
}
|
|
|
|
# Move the MPG into the local directory
|
|
file rename $tmp/mpg.mpg $file.mpg
|
|
lappend processed_files [$ts get file]
|
|
runplugin postmpg $ts
|
|
system endop mpg
|
|
}
|
|
|
|
proc do_mp3 {ts} {
|
|
global tmp tsgroup processed_files
|
|
|
|
set file [file rootname [$ts get file]]
|
|
|
|
if {[file exists $file.mp3]} {
|
|
# Already done.
|
|
return
|
|
}
|
|
|
|
if {[$ts flag "ODEncrypted"]} {
|
|
log " $file - Not decrypted." 2
|
|
return
|
|
}
|
|
|
|
if {[$ts get definition] eq "HD"} {
|
|
# Cannot extract a useful MP3 from a HD recording.
|
|
log " $file - High definition." 2
|
|
return
|
|
}
|
|
|
|
if {[inuse $ts]} {
|
|
log " $file - In use."
|
|
return
|
|
}
|
|
oktorun
|
|
system startop mp3 [$ts get file]
|
|
runplugin premp3 $ts
|
|
dsc [$ts size]
|
|
|
|
log " MP3: $file" 0
|
|
log " Converting... [$::settings audiomp3descr $::audiomp3]" 0
|
|
if {[catch {
|
|
set cmd [list nice -n 19 \
|
|
/mod/bin/ffmpeg -y -benchmark -v 0 -i "$file.ts" \
|
|
-f mp3 -vn]
|
|
if {!$::audiomp3} { lappend cmd -acodec copy }
|
|
lappend cmd "$tmp/mp3.mp3"
|
|
foreach line [split [exec {*}$cmd] "\n"] {
|
|
log $line 0
|
|
}
|
|
} msg]} {
|
|
log "Error during mp3 extract: $msg" 0
|
|
system notify "$file - auto-mp3 - error $msg."
|
|
system endop mp3
|
|
return
|
|
}
|
|
|
|
if {[system pkginst id3v2]} {
|
|
log [exec /mod/bin/id3v2 \
|
|
--song "[$ts get title]" \
|
|
--comment "[$ts get synopsis]" \
|
|
--album "[$ts get channel_name]" \
|
|
--year "[clock format [$ts get start] -format {%Y}]" \
|
|
"$tmp/mp3.mp3"] 0
|
|
}
|
|
|
|
# Move the MP3 into the local directory
|
|
file rename $tmp/mp3.mp3 $file.mp3
|
|
lappend processed_files [$ts get file]
|
|
runplugin postmp3 $ts
|
|
system endop mp3
|
|
}
|
|
|
|
proc entries {dir callback {flag ""}} {
|
|
foreach entry [readdir -nocomplain $dir] {
|
|
if {$flag ne "" && ![file exists $flag]} {
|
|
log "Flag $flag disappeared mid-run, aborting." 0
|
|
break
|
|
}
|
|
if {![string match {*.ts} $entry]} continue
|
|
if {[catch {set ts [ts fetch "$dir/$entry"]}]} continue
|
|
if {$ts == 0} continue
|
|
$callback $ts
|
|
}
|
|
}
|
|
|
|
proc shrink {dir {flag ""}} {
|
|
log "SHRINK: \[$dir]" 2
|
|
entries $dir do_shrink $flag
|
|
}
|
|
|
|
proc decrypt {dir {flag ""}} {
|
|
log "DECRYPT: \[$dir]" 2
|
|
if {$::dlnaok} { entries $dir do_decrypt $flag }
|
|
}
|
|
|
|
proc mpg {dir {flag ""}} {
|
|
log "MPG: \[$dir]" 2
|
|
entries $dir do_mpg $flag
|
|
}
|
|
|
|
proc mp3 {dir {flag ""}} {
|
|
log "MP3: \[$dir]" 2
|
|
entries $dir do_mp3 $flag
|
|
}
|
|
|
|
proc expire {dir {flag ""}} {
|
|
log "EXPIRE: \[$dir]" 2
|
|
|
|
# type 0 keep {} days 2 keepnew 0
|
|
set ax [dir expiry $dir]
|
|
log " $ax" 2
|
|
if {![string is integer -strict $ax(keep)]} { set ax(keep) 0 }
|
|
if {![string is integer -strict $ax(days)]} { set ax(days) 0 }
|
|
|
|
if {!$ax(keep) && !$ax(days)} {
|
|
log "Expire error ($dir): neither keep nor days set ($ax)" 0
|
|
return
|
|
}
|
|
|
|
if {$ax(type) eq "0"} {
|
|
set getter [lambda {ts} { list [$ts get end] }]
|
|
} else {
|
|
set getter [lambda {ts} { list [$ts lastmod] }]
|
|
}
|
|
|
|
set entries [lsort \
|
|
-command [lambda {a b} {upvar getter g; expr [$g $a] - [$g $b]}]\
|
|
[lmap i [readdir -nocomplain $dir] {
|
|
if {![string match {*.ts} $i]} continue
|
|
if {[catch {set ts [ts fetch "$dir/$i"]}]} continue
|
|
if {$ts == 0} continue
|
|
list $ts
|
|
}]]
|
|
|
|
# Entries are now sorted with oldest first, according to the selected
|
|
# criterion.
|
|
|
|
set num [llength $entries]
|
|
log " Entries: $num" 2
|
|
foreach e $entries { log " [file tail [$e get file]]" 2 }
|
|
|
|
set now [clock seconds]
|
|
foreach ts $entries {
|
|
set file [$ts get file]
|
|
if {$num <= $ax(keep)} {
|
|
log " Remaining ($num) <= keep ($ax(keep))" 2
|
|
break
|
|
}
|
|
log " [file tail $file]"
|
|
if {[inuse $ts]} {
|
|
log " In use, skipping."
|
|
continue
|
|
}
|
|
if {$ax(keepnew) ne "0" && [$ts flag New]} {
|
|
log " Unwatched, skipping."
|
|
continue
|
|
}
|
|
if {$ax(days) > 0} {
|
|
# Calculate age in days
|
|
set age $(($now - [$getter $ts]) / 86400.0)
|
|
log " $age days (cf. $ax(days))"
|
|
if {$age < $ax(days)} {
|
|
log " Too new, skipping."
|
|
continue
|
|
}
|
|
}
|
|
log " Removing."
|
|
runplugin preexpire $ts
|
|
if {![safe_delete $file]} {
|
|
log "Unknown error in safe_delete, aborting." 0
|
|
break
|
|
}
|
|
log " EXPIRE: removed $file" 0
|
|
runplugin postexpire $ts
|
|
incr ::recalc
|
|
incr num -1
|
|
}
|
|
}
|
|
|
|
proc scan_run {dir flag callback {seen {}}} {
|
|
global dustbin
|
|
|
|
if {$dir eq $dustbin} return
|
|
|
|
if {[specialdir $dir]} return
|
|
|
|
file stat $dir st
|
|
set key "$st(dev):$st(ino)"
|
|
if {$key in $seen} {
|
|
log "Already seen $dir ($key)" 2
|
|
return
|
|
}
|
|
lappend seen $key
|
|
|
|
if {[file exists "$dir/.$flag"]} { $callback $dir }
|
|
|
|
foreach entry [readdir -nocomplain $dir] {
|
|
if {[file isdirectory "$dir/$entry"]} {
|
|
scan_run "$dir/$entry" $flag $callback $seen
|
|
|
|
file stat "$dir/$entry" st
|
|
set key "$st(dev):$st(ino)"
|
|
lappend seen $key
|
|
}
|
|
}
|
|
}
|
|
|
|
proc xscan {dir attr {force 0} {recurse 1} {seen {}}} {{indent 0} {forceflag ""}} {
|
|
global dustbin
|
|
|
|
incr indent 2
|
|
|
|
log "[string repeat " " $indent]\[$dir]" 2
|
|
|
|
if {$dir eq $dustbin} {
|
|
log "[string repeat " " $indent]Dustbin, skipping." 2
|
|
incr indent -2
|
|
return
|
|
}
|
|
|
|
file stat "$dir/" st
|
|
|
|
if {[specialdir $dir]} {
|
|
# Special folder
|
|
if {$st(dev) != $::rootdev} {
|
|
log "[string repeat " " $indent]Special folder on different device, skipping." 2
|
|
incr indent -2
|
|
return
|
|
}
|
|
if {$force} {
|
|
set force 0
|
|
set forceflag ""
|
|
log "[string repeat " " $indent]Special folder, overriding recursion." 2
|
|
}
|
|
}
|
|
|
|
# Already seen
|
|
set key "$st(dev):$st(ino)"
|
|
if {$key in $seen} {
|
|
log "[string repeat " " $indent]Already seen, skipping." 2
|
|
incr indent -2
|
|
return
|
|
}
|
|
lappend seen $key
|
|
|
|
# Recursion
|
|
if {!$force && [file exists "$dir/.auto${attr}r"]} {
|
|
log "[string repeat " " $indent] (R)" 2
|
|
set force 1
|
|
set forceflag "$dir/.auto${attr}r"
|
|
}
|
|
|
|
oktorun
|
|
dsc
|
|
|
|
if {$force} {
|
|
$attr $dir $forceflag
|
|
} elseif {[file exists "$dir/.auto$attr"]} {
|
|
$attr $dir "$dir/.auto$attr"
|
|
}
|
|
|
|
foreach entry [readdir -nocomplain $dir] {
|
|
if {$recurse && [file isdirectory "$dir/$entry"]} {
|
|
xscan "$dir/$entry" $attr $force $recurse $seen
|
|
file stat "$dir/$entry" st
|
|
set key "$st(dev):$st(ino)"
|
|
lappend seen $key
|
|
}
|
|
}
|
|
|
|
dorecalc $dir
|
|
|
|
incr indent -2
|
|
}
|
|
|
|
proc scanup {dir flag} {
|
|
global root
|
|
|
|
set rl [string length $root]
|
|
while {[string length $dir] >= $rl} {
|
|
if {[specialdir $dir]} {
|
|
return -1
|
|
}
|
|
if {[file exists "$dir/.auto${flag}r"]} {
|
|
log "scanup: Found ${flag}r ($dir)" 2
|
|
return 1
|
|
}
|
|
set dir [file dirname $dir]
|
|
}
|
|
|
|
return 0
|
|
}
|
|
|
|
proc scansingle {dirs} {
|
|
global modules root
|
|
|
|
foreach dir $dirs {
|
|
log "Scanning single directory '$dir'"
|
|
foreach arg $modules {
|
|
set st [clock milliseconds]
|
|
set sup [scanup $dir $arg]
|
|
if {$sup == -1} {
|
|
log "Encountered special directory."
|
|
break
|
|
}
|
|
runplugin "pre${arg}singledir" $dir
|
|
xscan $dir $arg $sup 0
|
|
runplugin "post${arg}singledir" $dir
|
|
log "$arg scan completed in [elapsed $st] seconds."
|
|
}
|
|
}
|
|
}
|
|
|
|
file stat "$root/" rootstat
|
|
set rootdev $rootstat(dev)
|
|
log "Root device: $rootdev" 2
|
|
|
|
if {[lindex $argv 0] eq "-singledir"} {
|
|
scansingle [lrange $argv 1 end]
|
|
} elseif {[lindex $argv 0] eq "-queue"} {
|
|
log "Processing queue..." 2
|
|
queue startup
|
|
while {[llength [set q [queue pop]]]} {
|
|
oktorun
|
|
|
|
if {[catch {set ts [ts fetch [$q get file]]}]} {
|
|
$q update FAILED "Could not open recording." 1
|
|
continue
|
|
}
|
|
if {$ts == 0} {
|
|
$q update FAILED "Could not open recording." 1
|
|
continue
|
|
}
|
|
set act [$q get action]
|
|
if {![dict exists $::queue_actions $act]} {
|
|
log "Unknown queue action, $act"
|
|
$q update FAILED "Unknown queue action, $act" 1
|
|
continue
|
|
}
|
|
set func $::queue_actions($act)
|
|
$q update RUNNING "Started at [clock format [clock seconds]]"
|
|
set start [clock seconds]
|
|
if {[catch {$func $ts} msg]} {
|
|
$q update FAILED $msg 1
|
|
continue
|
|
}
|
|
set elapsed $([clock seconds] - $start)
|
|
$q update COMPLETE \
|
|
"Completed at [clock format [clock seconds]]" 0 $elapsed
|
|
}
|
|
} elseif {[llength $argv] > 0} {
|
|
set loglevel 2
|
|
foreach arg $argv {
|
|
set st [clock milliseconds]
|
|
if {$arg ni $modules} {
|
|
log "Unknown scan type: $arg"
|
|
continue
|
|
}
|
|
log "$arg scan starting."
|
|
set processed_files {}
|
|
runplugin "pre${arg}scan"
|
|
xscan $root $arg
|
|
runplugin "post${arg}scan" processed_files
|
|
log "$arg scan completed in [elapsed $st] seconds."
|
|
}
|
|
} else {
|
|
foreach arg $modules {
|
|
set st [clock milliseconds]
|
|
log "$arg scan starting."
|
|
set processed_files {}
|
|
runplugin "pre${arg}scan"
|
|
xscan $root $arg
|
|
runplugin "post${arg}scan" processed_files
|
|
log "$arg scan completed in [elapsed $st] seconds."
|
|
}
|
|
}
|
|
|
|
if {!$prelocked} { release_lock webif_auto }
|
|
|
|
log "Media scan completed in [elapsed $scanstart] seconds."
|
|
|