#!/mod/bin/jimsh

source /mod/webif/lib/setup
require lock system.class ts.class pretty_size browse.class \
    safe_delete settings.class plugin

set settings [settings]
set loglevel [$settings autolog]
set audiomp3 [$settings audiomp3]

set modules {decrypt dedup shrink mpg mp3 expire}

set root [system mediaroot]

set logfile "/mod/tmp/auto.log"

set logfd "unset"
set logprefix ""
set prelocked 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]
			}
		}
		default {
			# Unknown option, pass to rest of script.
			break
		}
	}
	set argv [lrange $argv 1 end]
}

if {!$prelocked && ![acquire_lock webif_auto 10 1]} {
	if {$loglevel > 1} {
		system plog auto "Could not acquire lock."
	}
	puts "Could 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 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 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
	}
}

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
	}
	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.
	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
		system notify "$file - auto-decrypt failed."
		file tdelete "$tmp/$bfile"
		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
	}
	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
	}
	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"
	}

	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 {[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."

