src/stats/webbw.sml

   1 (*
   2 Domtool 2 (http://hcoop.sf.net/)
   3 Copyright (C) 2004-2007  Adam Chlipala
   4
   5 This program is free software; you can redistribute it and/or
   6 modify it under the terms of the GNU General Public License
   7 as published by the Free Software Foundation; either version 2
   8 of the License, or (at your option) any later version.
   9
  10 This program is distributed in the hope that it will be useful,
  11 but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 GNU General Public License for more details.
  14
  15 You should have received a copy of the GNU General Public License
  16 along with this program; if not, write to the Free Software
  17 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  18 *)
  19
  20 (* Generation of aggregate per-user/per-vhost web bandwidth statistics *)
  21
  22 structure Webbw = struct
  23
  24 val groupsBase = Config.Webalizer.defaultOutput
  25 (* Where to look for grouped user statistics *)
  26
  27 fun mots m =
  28     let
  29         open Date
  30     in
  31         case m of
  32             Jan => "Jan"
  33           | Feb => "Feb"
  34           | Mar => "Mar"
  35           | Apr => "Apr"
  36           | May => "May"
  37           | Jun => "Jun"
  38           | Jul => "Jul"
  39           | Aug => "Aug"
  40           | Sep => "Sep"
  41           | Oct => "Oct"
  42           | Nov => "Nov"
  43           | Dec => "Dec"
  44     end
  45
  46 fun motn m =
  47     let
  48         open Date
  49     in
  50         case m of
  51             Jan => "01"
  52           | Feb => "02"
  53           | Mar => "03"
  54           | Apr => "04"
  55           | May => "05"
  56           | Jun => "06"
  57           | Jul => "07"
  58           | Aug => "08"
  59           | Sep => "09"
  60           | Oct => "10"
  61           | Nov => "11"
  62           | Dec => "12"
  63     end
  64
  65 val monthInc = Time.fromSeconds (LargeInt.fromInt 2592000)
  66
  67 fun doit () =
  68     let
  69         val now = Date.fromTimeLocal (Time.now ())
  70
  71         fun backupMonth t =
  72             let
  73                 val now = Date.fromTimeLocal t
  74
  75                 fun backupMonth' t =
  76                     let
  77                         val d = Date.fromTimeLocal t
  78                     in
  79                         if Date.month d = Date.month now then
  80                             backupMonth' (Time.- (t, monthInc))
  81                         else
  82                             t
  83                     end
  84             in
  85                 backupMonth' t
  86             end
  87
  88         fun backupMulti n =
  89             if n = 0 then
  90                 Time.now ()
  91             else
  92                 backupMonth (backupMulti (n-1))
  93
  94         val now =
  95             case CommandLine.arguments () of
  96                 [n] =>
  97                 (case Int.fromString n of
  98                      NONE => raise Fail "Invalid integer parameter"
  99                    | SOME n =>
 100                      if n >= 0 then
 101                          Date.fromTimeLocal (backupMulti n)
 102                      else
 103                          raise Fail "Negative parameter")
 104               | _ => now
 105
 106         val when = mots (Date.month now) ^ " " ^ Int.toString (Date.year now)
 107
 108         val groups = let
 109             val inf = TextIO.openIn (groupsBase ^ Int.toString (Date.year now) ^ motn (Date.month now) ^ ".html")
 110             val _ = TextIO.inputLine inf
 111             val _ = TextIO.inputLine inf
 112             val _ = TextIO.inputLine inf
 113             val _ = TextIO.inputLine inf
 114
 115             fun loop groups =
 116                 case TextIO.inputLine inf of
 117                     NONE => groups
 118                   | SOME line =>
 119                     case String.tokens Char.isSpace line of
 120                         [hits, perc, kb, kbperc, url] =>
 121                         if size url >= 4
 122                            andalso String.sub (url, 0) = #"/"
 123                            andalso String.sub (url, 1) = #"~"
 124                            andalso String.sub (url, size url - 2) = #"/"
 125                            andalso String.sub (url, size url - 1) = #"*" then
 126                             let
 127                                 val uname = String.substring (url, 2, size url - 4)
 128                             in
 129                                 loop (((uname, ["www.hcoop.net"]),
 130                                        valOf (Int.fromString kb)) :: groups)
 131                             end
 132                         else
 133                             loop groups
 134                       | _ => groups
 135
 136             val groups : ((string * string list) * int) list ref = ref (loop [])
 137             val _ = TextIO.closeIn inf
 138         in
 139             groups
 140         end handle ex => ref []
 141
 142         fun addGroup (group, n, d, d') =
 143             let
 144                 val groups' = if List.exists (fn ((x, _), _) => x = group) (!groups) then
 145                                   map (fn v as ((gr, ds), n') => if gr = group then ((gr, d ^ ":" ^ d' :: ds), n + n') else v) (!groups)
 146                               else
 147                                   ((group, [d ^ ":" ^ d']), n) :: (!groups)
 148             in
 149                 groups := groups'
 150             end
 151
 152         fun dodir {node, host} =
 153             let
 154                 val file = Config.Webalizer.outputDir ^ "/" ^ node ^ "/" ^ host ^ "/index.html"
 155             in
 156                 if not (Posix.FileSys.access (file, [])) then
 157                     NONE
 158                 else
 159                     let
 160                         val inf = TextIO.openIn file
 161
 162                         fun andWeep () =
 163                             let
 164                                 fun waste n =
 165                                     if n <= 0 then
 166                                         ()
 167                                     else
 168                                         (TextIO.inputLine inf;
 169                                          waste (n-1))
 170
 171                                 val _ = waste 5
 172
 173                                 val l = valOf (TextIO.inputLine inf)
 174                                 val num = String.extract (l, 32, NONE)
 175
 176                                 fun getNum i =
 177                                     if Char.isDigit (String.sub (num, i)) then
 178                                         getNum (i+1)
 179                                     else
 180                                         valOf (Int.fromString (String.substring (num, 0, i)))
 181                             in
 182                                 getNum 0
 183                             end
 184
 185                         fun readEm () =
 186                             case TextIO.inputLine inf of
 187                                 NONE => NONE
 188                               | SOME l =>
 189                                 if Substring.isSubstring when (Substring.full l) then
 190                                     SOME (andWeep ())
 191                                 else
 192                                     readEm ()
 193
 194                         val ret = readEm ()
 195
 196                         val group =
 197                             if host <> Config.Webalizer.defaultHost then
 198                                 let
 199                                     val tokens = String.tokens (fn ch => ch = #".") host
 200                                     val (tokens, ssl) =
 201                                         case rev tokens of
 202                                             "ssl" :: tokens => (rev tokens, true)
 203                                           | _ => (tokens, false)
 204                                     val (host, tokens) =
 205                                         case tokens of
 206                                             host :: tokens => (host, tokens)
 207                                           | _ => raise Fail "Host name too short"
 208
 209                                     val file = Config.resultRoot ^ "/" ^ node ^ "/" ^ String.concatWith "/" (rev tokens)
 210                                                ^ "/" ^ host ^ "." ^ String.concatWith "." tokens ^ ".vhost"
 211                                     val file = if ssl then
 212                                                    file ^ "_ssl"
 213                                                else
 214                                                    file
 215
 216                                     val inf = TextIO.openIn file
 217                                     val line = case TextIO.inputLine inf of
 218                                                    NONE => raise Fail ("Empty file: " ^ file)
 219                                                  | SOME line => line
 220
 221                                     val user = case String.tokens Char.isSpace line of
 222                                                    [_, _, user] => user
 223                                                  | _ => raise Fail ("Bad vhost file format in " ^ file)
 224                                 in
 225                                     TextIO.closeIn inf;
 226                                     SOME user
 227                                 end
 228                             else
 229                                 NONE
 230                     in
 231                         (case (ret, group) of
 232                              (SOME ret, SOME group) => addGroup (group, ret, node, host)
 233                            | _ => ());
 234                         TextIO.closeIn inf;
 235                         ret
 236                     end handle IO.Io {name, function, ...} => NONE
 237             end
 238
 239         val dir = Posix.FileSys.opendir Config.Webalizer.outputDir
 240
 241         fun loop L =
 242             case Posix.FileSys.readdir dir of
 243                 NONE => L
 244               | SOME d =>
 245                 let
 246                     val dir = Posix.FileSys.opendir (OS.Path.joinDirFile {dir = Config.Webalizer.outputDir,
 247                                                                           file = d})
 248
 249                     fun loop' L =
 250                         case Posix.FileSys.readdir dir of
 251                             NONE => L
 252                           | SOME d' =>
 253                             case dodir {node = d, host = d'} of
 254                                 NONE => loop' L
 255                               | SOME n => loop' (((d, d'), n) :: L)
 256
 257                     val L =
 258                         if d = "main" then
 259                             L
 260                         else
 261                             loop' L
 262                 in
 263                     loop L
 264                 end
 265
 266         fun sort ls = ListMergeSort.sort (fn ((_, n1), (_, n2)) => n1 > n2) ls
 267
 268         val doms = loop []
 269         val doms = sort doms
 270         val groups = sort (!groups)
 271
 272         val sum = List.foldl (fn ((_, n), s) => s+n) 0 doms
 273     in
 274         print ("TOTAL: " ^ Int.toString sum ^ "\n\n");
 275         List.app (fn ((d, d'), n) => print (d ^ ":" ^ d' ^ ": " ^ Int.toString n ^ "\n")) doms;
 276         print "\n";
 277         List.app (fn ((d, ds), n) => print (d ^ "[" ^ String.concatWith "," ds ^ "]: " ^ Int.toString n ^ "\n")) groups;
 278         Posix.FileSys.closedir dir
 279     end
 280
 281 end
 282