web/cgi/alpine/whackatch.tcl

   1 #!./tclsh
   2 # $Id: whackatch.tcl 1266 2009-07-14 18:39:12Z hubert@u.washington.edu $
   3 # ========================================================================
   4 # Copyright 2006 University of Washington
   5 #
   6 # Licensed under the Apache License, Version 2.0 (the "License");
   7 # you may not use this file except in compliance with the License.
   8 # You may obtain a copy of the License at
   9 #
  10 #     http://www.apache.org/licenses/LICENSE-2.0
  11 #
  12 # ========================================================================
  13
  14 #  whackatch.tcl
  15 #
  16 #  Purpose:  CGI script to cleanup requested attachment
  17
  18 #  Input:
  19 #   ext - attachment file extension
  20
  21 #  Output:
  22 #
  23
  24 # inherit global config
  25 source ./alpine.tcl
  26
  27 # seconds to pause before rechecking for abandanded attachment files
  28 set abandoned 300
  29
  30 # no dots allowed
  31 if {[gets stdin ext] >= 0 && [regexp {^[A-Za-z0-9\-]+$} $ext ext] == 1} {
  32
  33   set towhack [file join $_wp(fileroot) $_wp(detachpath) detach.${ext}]
  34
  35   while {1} {
  36     set timein [clock seconds]
  37
  38     after [expr {$abandoned * 1000}]
  39
  40     if {[catch {file atime $towhack} atime] || ($timein - $atime) > $abandoned} {
  41       break
  42     }
  43   }
  44
  45   catch {exec /bin/rm -f $towhack}
  46 }