src/utils/lib/syslog.ml

   1 (* syslog(3) routines for ocaml
   2    This library is based on Shawn Wagner's original syslog
   3    library as included in annexlib, with significant modifications
   4    by by Eric Stokes <eric.stokes@csun.edu>.
   5
   6    Copyright (C) 2002 Shawn Wagner <raevnos@pennmush.org>
   7    Copyright (C) 2005 Eric Stokes <eric.stokes@csun.edu>
   8
   9    This library is free software; you can redistribute it and/or
  10    modify it under the terms of the GNU Lesser General Public
  11    License as published by the Free Software Foundation; either
  12    version 2.1 of the License, or (at your option) any later version.
  13
  14    This library is distributed in the hope that it will be useful,
  15    but WITHOUT ANY WARRANTY; without even the implied warranty of
  16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17    Lesser General Public License for more details.
  18
  19    You should have received a copy of the GNU Lesser General Public
  20    License along with this library; if not, write to the Free Software
  21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22 *)
  23
  24 open Unix
  25
  26 (** The assorted logging facilities. The default is [`LOG_USER]. You
  27     can set a new default with openlog, or give a specific facility per
  28     syslog call. *)
  29 type facility =
  30     [ `LOG_KERN | `LOG_USER | `LOG_MAIL | `LOG_DAEMON | `LOG_AUTH
  31     | `LOG_SYSLOG | `LOG_LPR | `LOG_NEWS | `LOG_UUCP | `LOG_CRON
  32     | `LOG_AUTHPRIV | `LOG_FTP | `LOG_NTP | `LOG_SECURITY
  33     | `LOG_CONSOLE | `LOG_LOCAL0 | `LOG_LOCAL1 | `LOG_LOCAL2
  34     | `LOG_LOCAL3 | `LOG_LOCAL4 | `LOG_LOCAL5 | `LOG_LOCAL6
  35     | `LOG_LOCAL7 ]
  36
  37 (** Flags to pass to openlog. [`LOG_CONS] isn't implemented yet. *)
  38 type flag = [ `LOG_CONS | `LOG_PERROR | `LOG_PID ]
  39
  40 (** The priority of the error. *)
  41 type level = [ `LOG_EMERG | `LOG_ALERT | `LOG_CRIT | `LOG_ERR | `LOG_WARNING
  42              | `LOG_NOTICE | `LOG_INFO | `LOG_DEBUG ]
  43
  44 exception Syslog_error of string
  45
  46 let facility_of_string s =
  47   match String.lowercase s with
  48       "kern" -> `LOG_KERN
  49     | "user" -> `LOG_USER
  50     | "mail" -> `LOG_MAIL
  51     | "daemon" -> `LOG_DAEMON
  52     | "auth" -> `LOG_AUTH
  53     | "syslog" -> `LOG_SYSLOG
  54     | "lpr" -> `LOG_LPR
  55     | "news" -> `LOG_NEWS
  56     | "uucp" -> `LOG_UUCP
  57     | "cron" -> `LOG_CRON
  58     | "authpriv" -> `LOG_AUTHPRIV
  59     | "ftp" -> `LOG_FTP
  60     | "ntp" -> `LOG_NTP
  61     | "security" -> `LOG_SECURITY
  62     | "console" -> `LOG_CONSOLE
  63     | "local0" -> `LOG_LOCAL0
  64     | "local1" -> `LOG_LOCAL1
  65     | "local2" -> `LOG_LOCAL2
  66     | "local3" -> `LOG_LOCAL3
  67     | "local4" -> `LOG_LOCAL4
  68     | "local5" -> `LOG_LOCAL5
  69     | "local6" -> `LOG_LOCAL6
  70     | "local7" -> `LOG_LOCAL7
  71     | invalid -> raise
  72         (Syslog_error
  73            ("facility_of_string: invalid facility, " ^
  74               invalid))
  75
  76 let facility_to_num fac =
  77   Int32.of_int (match fac with
  78                   | `LOG_KERN -> 0 lsl 3
  79                   | `LOG_USER -> 1 lsl 3
  80                   | `LOG_MAIL -> 2 lsl 3
  81                   | `LOG_DAEMON -> 3 lsl 3
  82                   | `LOG_AUTH -> 4 lsl 3
  83                   | `LOG_SYSLOG -> 5 lsl 3
  84                   | `LOG_LPR -> 6 lsl 3
  85                   | `LOG_NEWS -> 7 lsl 3
  86                   | `LOG_UUCP -> 8 lsl 3
  87                   | `LOG_CRON -> 9 lsl 3
  88                   | `LOG_AUTHPRIV -> 10 lsl 3
  89                   | `LOG_FTP -> 11 lsl 3
  90                   | `LOG_NTP -> 12 lsl 3
  91                   | `LOG_SECURITY -> 13 lsl 3
  92                   | `LOG_CONSOLE -> 14 lsl 3
  93                   | `LOG_LOCAL0 -> 16 lsl 3
  94                   | `LOG_LOCAL1 -> 17 lsl 3
  95                   | `LOG_LOCAL2 -> 18 lsl 3
  96                   | `LOG_LOCAL3 -> 19 lsl 3
  97                   | `LOG_LOCAL4 -> 20 lsl 3
  98                   | `LOG_LOCAL5 -> 21 lsl 3
  99                   | `LOG_LOCAL6 -> 22 lsl 3
 100                   | `LOG_LOCAL7 -> 23 lsl 3)
 101
 102 let level_to_num lev =
 103   Int32.of_int (match lev with
 104                   | `LOG_EMERG -> 0
 105                   | `LOG_ALERT -> 1
 106                   | `LOG_CRIT -> 2
 107                   | `LOG_ERR -> 3
 108                   | `LOG_WARNING -> 4
 109                   | `LOG_NOTICE -> 5
 110                   | `LOG_INFO -> 6
 111                   | `LOG_DEBUG -> 7)
 112
 113
 114 let level_mask = 0x07
 115 let facility_mask = 0x03f8
 116
 117 type t = {
 118   mutable fd: Unix.file_descr;
 119   mutable connected: bool;
 120   mutable flags: flag list;
 121   mutable tag: string;
 122   mutable fac: int32;
 123   mutable logpath: string;
 124 }
 125
 126 let open_connection loginfo =
 127   let module U = Unix.LargeFile in
 128   match loginfo.logpath with
 129       "" -> raise (Syslog_error "unable to find the syslog socket or pipe, is syslogd running?")
 130     | logpath ->
 131         (match (U.stat logpath).U.st_kind with
 132              Unix.S_SOCK ->
 133                let logaddr = Unix.ADDR_UNIX logpath in
 134                  (try
 135                     loginfo.fd <- Unix.socket Unix.PF_UNIX SOCK_DGRAM 0;
 136                     Unix.connect loginfo.fd logaddr
 137                   with Unix.Unix_error (Unix.EPROTOTYPE, _, _) ->
 138                     (* try again with a stream socket for syslog-ng *)
 139                     loginfo.fd <- Unix.socket Unix.PF_UNIX SOCK_STREAM 0;
 140                     Unix.connect loginfo.fd logaddr);
 141                  loginfo.connected <- true;
 142            | Unix.S_FIFO ->
 143                loginfo.fd <- Unix.openfile logpath [Unix.O_WRONLY] 0o666;
 144                loginfo.connected <- true;
 145            | _ -> raise (Syslog_error "invalid log path, not a socket or pipe"))
 146
 147 let openlog
 148     ?(logpath=(try ignore (Unix.stat "/dev/log");"/dev/log"
 149                with Unix.Unix_error (Unix.ENOENT, _, _) ->
 150                  (try ignore (Unix.stat "/var/run/syslog");"/var/run/syslog"
 151                   with Unix.Unix_error (Unix.ENOENT, _, _) -> "")))
 152     ?(facility=`LOG_USER)
 153     ?(flags=[])
 154     ident =
 155   let loginfo = {fd = Unix.stderr;
 156                  connected = false;
 157                  flags = flags;
 158                  tag = ident;
 159                  fac = facility_to_num facility;
 160                  logpath = logpath}
 161   in
 162     open_connection loginfo;
 163     loginfo
 164
 165 let log_console _msg = ()
 166
 167 let ascdate {tm_sec=sec;tm_min=min;tm_hour=hour;
 168              tm_mday=mday;tm_mon=mon;tm_year=_;
 169              tm_wday=_;tm_yday=_;tm_isdst=_} =
 170   let asc_mon =
 171     match mon with
 172         0 -> "Jan"
 173       | 1 -> "Feb"
 174       | 2 -> "Mar"
 175       | 3 -> "Apr"
 176       | 4 -> "May"
 177       | 5 -> "Jun"
 178       | 6 -> "Jul"
 179       | 7 -> "Aug"
 180       | 8 -> "Sep"
 181       | 9 -> "Oct"
 182       | 10 -> "Nov"
 183       | 11 -> "Dec"
 184       | _ -> raise (Syslog_error "invalid month")
 185   in
 186     (Printf.sprintf "%s %02d %02d:%02d:%02d" asc_mon mday hour min sec)
 187
 188 let protected_write loginfo str =
 189   let fallback _ =
 190     (try close loginfo.fd with _ -> ());
 191     loginfo.connected <- false;
 192     (try open_connection loginfo with _ -> ());
 193     if List.mem `LOG_CONS loginfo.flags then log_console str
 194   in
 195   let prev = Sys.signal Sys.sigpipe (Sys.Signal_handle fallback) in
 196   try
 197     ignore (write_substring loginfo.fd str 0 (String.length str));
 198     Sys.set_signal Sys.sigpipe prev
 199   with Unix_error (_, _, _) ->
 200     (* on error, attempt to reconnect *)
 201     fallback ();
 202     Sys.set_signal Sys.sigpipe prev
 203
 204 let syslog ?fac loginfo lev str =
 205   let msg = Buffer.create 64 in
 206   let realfac = match fac with
 207     | Some f -> facility_to_num f
 208     | None -> loginfo.fac in
 209   let levfac = Int32.logor realfac (level_to_num lev)
 210   and now = ascdate (localtime (Unix.time ())) in
 211     Printf.bprintf msg "<%ld>%.15s " levfac now;
 212     let len1 = Buffer.length msg
 213     and len2 = String.length loginfo.tag in
 214       if len1 + len2 < 64 then
 215         Buffer.add_string msg loginfo.tag
 216       else
 217         Buffer.add_substring msg loginfo.tag 0 (64 - len1);
 218       if List.mem `LOG_PID loginfo.flags then
 219         Printf.bprintf msg "[%d]" (Unix.getpid());
 220       if String.length loginfo.tag > 0 then
 221         Buffer.add_string msg ": ";
 222       Buffer.add_string msg str;
 223       let realmsg = ref (Buffer.contents msg) in
 224         if String.length !realmsg > 1024 then begin
 225           realmsg := String.sub !realmsg 0 1012 ^ "<truncated>"
 226         end;
 227         protected_write loginfo !realmsg;
 228         if List.mem `LOG_PERROR loginfo.flags then begin
 229           try
 230             ignore (Unix.write_substring Unix.stderr !realmsg 0 (String.length !realmsg));
 231             ignore (Unix.write_substring Unix.stderr "\n" 0 1)
 232           with _ -> ()
 233         end
 234
 235 let closelog loginfo =
 236   if loginfo.connected then
 237     begin
 238       Unix.close loginfo.fd;
 239       loginfo.connected <- false
 240     end;
 241   loginfo.flags <- [];
 242   loginfo.tag <- "";
 243   loginfo.fac <- facility_to_num `LOG_USER