├── .gitignore ├── CHANGES.md ├── LICENSE.md ├── README.md ├── dune-project ├── src ├── dune ├── syslog_message.ml └── syslog_message.mli ├── syslog-message.opam └── test ├── dune └── test_syslog_message.ml /.gitignore: -------------------------------------------------------------------------------- 1 | # Dune generated files 2 | _build/ 3 | *.install 4 | 5 | # Merlin configuring file for Vim and Emacs 6 | .merlin 7 | 8 | # Local OPAM switch 9 | _opam/ 10 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## 1.2.0 (2023-06-03) 2 | 3 | * remove dependency on astring (#28, @hannesm) 4 | * use OCaml-CI (#27, @Leonidas-from-XIV, @verbosemode) 5 | * bump required dune version to 2.0 6 | * raise lower bound to ocaml 4.08.0; remove rresult dependency (#25, by @hannesm) 7 | 8 | ## 1.1.0 (2019-04-14) 9 | 10 | * additonal conversion and pretty printer functions (#23, by @vbmithr) 11 | 12 | ## 1.0.0 (2018-10-14) 13 | 14 | * Warning: encode function no longer truncates messages to 1024 bytes by default 15 | * split message part into tag and content (#20, by @hannesm) 16 | * use result types instead of option (#20, by @hannesm) 17 | * remove transport-dependent length check from encode (#20, by @hannesm) 18 | * switch build system to Dune (#19, by @dra27) 19 | * add encode_local for sending to local syslog (#17, by @dra27) 20 | * forgot to thank @hannesm, @Leonidas-from-XIV for past contributions 21 | 22 | ## 0.0.2 (2016-10-29) 23 | 24 | * simplify API: no set_hostname, hostname anymore #11 25 | * introduce Rfc3164_timestamp module #11 26 | * parse is now decode, to_string encode #11 27 | * pp_string is now to_string #11 28 | * provide pp : Format.formatter -> t -> unit 29 | * remove int_to_severity/severity_to_int/int_to_facility/facility_to_int #11 30 | * use topkg instead of oasis 31 | * cleanups #8 #9 32 | 33 | ## 0.0.1 (2016-03-24) 34 | 35 | * Initial release supporting RFC 3164 36 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Jochen Bartl 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 15 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 16 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 18 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 19 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 20 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 21 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 22 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 23 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## syslog-message - Syslog message parser 2 | 3 | %%VERSION%% 4 | 5 | This is a library for parsing and generating RFC 3164 compatible Syslog messages. 6 | 7 | ## Documentation 8 | 9 | [![Build Status](https://img.shields.io/endpoint?url=https%3A%2F%2Fci.ocamllabs.io%2Fbadge%2Fverbosemode%2Fsyslog-message%2Fmain&logo=ocaml)](https://ci.ocamllabs.io/github/verbosemode/syslog-message) 10 | 11 | [API documentation](https://verbosemode.github.io/syslog-message/doc/) is available online. 12 | 13 | ```ocaml 14 | match Ptime.of_date_time ((1970, 1, 1), ((0, 0, 0), 0)) with 15 | | Some ts -> Syslog_message.decode ~ctx:{timestamp=ts; hostname="-"; set_hostname=false} "<133>Oct 3 15:51:21 server001: foobar" 16 | | None -> failwith "Failed to parse Syslog message";; 17 | - : Syslog_message.t option = 18 | Some {Syslog_message.facility = Syslog_message.Local0; severity = Syslog_message.Notice; timestamp = ; 19 | hostname = "server001"; message = "foobar"} 20 | ``` 21 | 22 | ## Installation 23 | 24 | This library can be installed with `opam`: `opam install syslog-message` 25 | 26 | ## Testing 27 | 28 | A test suite using qcheck is provided: `opam install --build-test syslog-message` 29 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | (name syslog-message) 3 | (formatting disabled) 4 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name syslog_message) 3 | (public_name syslog-message) 4 | (synopsis "Syslog Message Parser") 5 | (libraries ptime)) 6 | -------------------------------------------------------------------------------- /src/syslog_message.ml: -------------------------------------------------------------------------------- 1 | let ( let* ) = Result.bind 2 | 3 | type facility = 4 | | Kernel_Message 5 | | User_Level_Messages 6 | | Mail_System 7 | | System_Daemons 8 | | Security_Authorization_Messages 9 | | Messages_Generated_Internally_By_Syslogd 10 | | Line_Printer_Subsystem 11 | | Network_News_Subsystem 12 | | UUCP_subsystem 13 | | Clock_Daemon 14 | | Security_Authorization_Messages_10 15 | | Ftp_Daemon 16 | | Ntp_Subsystem 17 | | Log_Audit 18 | | Log_Alert 19 | | Clock_Daemon_15 20 | | Local0 21 | | Local1 22 | | Local2 23 | | Local3 24 | | Local4 25 | | Local5 26 | | Local6 27 | | Local7 28 | 29 | let int_of_facility = function 30 | | Kernel_Message -> 0 31 | | User_Level_Messages -> 1 32 | | Mail_System -> 2 33 | | System_Daemons -> 3 34 | | Security_Authorization_Messages -> 4 35 | | Messages_Generated_Internally_By_Syslogd -> 5 36 | | Line_Printer_Subsystem -> 6 37 | | Network_News_Subsystem -> 7 38 | | UUCP_subsystem -> 8 39 | | Clock_Daemon -> 9 40 | | Security_Authorization_Messages_10 -> 10 41 | | Ftp_Daemon -> 11 42 | | Ntp_Subsystem -> 12 43 | | Log_Audit -> 13 44 | | Log_Alert -> 14 45 | | Clock_Daemon_15 -> 15 46 | | Local0 -> 16 47 | | Local1 -> 17 48 | | Local2 -> 18 49 | | Local3 -> 19 50 | | Local4 -> 20 51 | | Local5 -> 21 52 | | Local6 -> 22 53 | | Local7 -> 23 54 | 55 | let facility_of_int = function 56 | | 0 -> Some Kernel_Message 57 | | 1 -> Some User_Level_Messages 58 | | 2 -> Some Mail_System 59 | | 3 -> Some System_Daemons 60 | | 4 -> Some Security_Authorization_Messages 61 | | 5 -> Some Messages_Generated_Internally_By_Syslogd 62 | | 6 -> Some Line_Printer_Subsystem 63 | | 7 -> Some Network_News_Subsystem 64 | | 8 -> Some UUCP_subsystem 65 | | 9 -> Some Clock_Daemon 66 | | 10 -> Some Security_Authorization_Messages_10 67 | | 11 -> Some Ftp_Daemon 68 | | 12 -> Some Ntp_Subsystem 69 | | 13 -> Some Log_Audit 70 | | 14 -> Some Log_Alert 71 | | 15 -> Some Clock_Daemon_15 72 | | 16 -> Some Local0 73 | | 17 -> Some Local1 74 | | 18 -> Some Local2 75 | | 19 -> Some Local3 76 | | 20 -> Some Local4 77 | | 21 -> Some Local5 78 | | 22 -> Some Local6 79 | | 23 -> Some Local7 80 | | _ -> None 81 | 82 | let string_of_facility = function 83 | | Kernel_Message -> "kern" 84 | | User_Level_Messages -> "user" 85 | | Mail_System -> "mail" 86 | | System_Daemons -> "daemon" 87 | | Security_Authorization_Messages -> "security/auth" 88 | | Messages_Generated_Internally_By_Syslogd -> "syslog" 89 | | Line_Printer_Subsystem -> "lpr" 90 | | Network_News_Subsystem -> "news" 91 | | UUCP_subsystem -> "uucp" 92 | | Clock_Daemon -> "clock" 93 | | Security_Authorization_Messages_10 -> "security/auth-10" 94 | | Ftp_Daemon -> "ftp" 95 | | Ntp_Subsystem -> "ntp" 96 | | Log_Audit -> "log-audit" 97 | | Log_Alert -> "log-alert" 98 | | Clock_Daemon_15 -> "clock-15" 99 | | Local0 -> "local0" 100 | | Local1 -> "local1" 101 | | Local2 -> "local2" 102 | | Local3 -> "local3" 103 | | Local4 -> "local4" 104 | | Local5 -> "local5" 105 | | Local6 -> "local6" 106 | | Local7 -> "local7" 107 | 108 | let pp_print_facility ppf f = 109 | Format.fprintf ppf "%s" (string_of_facility f) 110 | 111 | type severity = 112 | | Emergency 113 | | Alert 114 | | Critical 115 | | Error 116 | | Warning 117 | | Notice 118 | | Informational 119 | | Debug 120 | 121 | let int_of_severity = function 122 | | Emergency -> 0 123 | | Alert -> 1 124 | | Critical -> 2 125 | | Error -> 3 126 | | Warning -> 4 127 | | Notice -> 5 128 | | Informational -> 6 129 | | Debug -> 7 130 | 131 | let severity_of_int = function 132 | | 0 -> Some Emergency 133 | | 1 -> Some Alert 134 | | 2 -> Some Critical 135 | | 3 -> Some Error 136 | | 4 -> Some Warning 137 | | 5 -> Some Notice 138 | | 6 -> Some Informational 139 | | 7 -> Some Debug 140 | | _ -> None 141 | 142 | let string_of_severity = function 143 | | Emergency -> "emerg" 144 | | Alert -> "alert" 145 | | Critical -> "crit" 146 | | Error -> "err" 147 | | Warning -> "warning" 148 | | Notice -> "notice" 149 | | Informational -> "info" 150 | | Debug -> "debug" 151 | 152 | let pp_print_severity ppf s = 153 | Format.fprintf ppf "%s" (string_of_severity s) 154 | 155 | type ctx = { 156 | timestamp : Ptime.t; 157 | hostname : string; 158 | set_hostname : bool 159 | } 160 | 161 | type t = { 162 | facility : facility; 163 | severity : severity; 164 | timestamp : Ptime.t; 165 | hostname : string; 166 | tag : string; 167 | content : string 168 | } 169 | 170 | module Rfc3164_Timestamp = struct 171 | let int_of_month_name = function 172 | | "Jan" -> Some 1 173 | | "Feb" -> Some 2 174 | | "Mar" -> Some 3 175 | | "Apr" -> Some 4 176 | | "May" -> Some 5 177 | | "Jun" -> Some 6 178 | | "Jul" -> Some 7 179 | | "Aug" -> Some 8 180 | | "Sep" -> Some 9 181 | | "Oct" -> Some 10 182 | | "Nov" -> Some 11 183 | | "Dec" -> Some 12 184 | | _ -> None 185 | 186 | let month_name_of_int = function 187 | | 1 -> "Jan" 188 | | 2 -> "Feb" 189 | | 3 -> "Mar" 190 | | 4 -> "Apr" 191 | | 5 -> "May" 192 | | 6 -> "Jun" 193 | | 7 -> "Jul" 194 | | 8 -> "Aug" 195 | | 9 -> "Sep" 196 | | 10 -> "Oct" 197 | | 11 -> "Nov" 198 | | 12 -> "Dec" 199 | | _ -> failwith "Invalid month integer" 200 | 201 | let encode ts = 202 | let ((_, month, day), ((h, m, s), _)) = Ptime.to_date_time ts in 203 | Printf.sprintf "%s %.2i %.2i:%.2i:%.2i" (month_name_of_int month) day h m s 204 | 205 | let decode s year : (Ptime.t * string, [> `Msg of string ]) result = 206 | let tslen = 16 in 207 | match String.length s with 208 | | l when l < tslen -> 209 | Error (`Msg "timestamp too short, must be at least 16 bytes") 210 | | l -> 211 | let month = int_of_month_name @@ String.sub s 0 3 in 212 | let day = String.sub s 4 2 |> String.trim |> int_of_string_opt in 213 | let hour = String.sub s 7 2 |> int_of_string_opt in 214 | let minute = String.sub s 10 2 |> int_of_string_opt in 215 | let second = String.sub s 13 2 |> int_of_string_opt in 216 | match month, day, hour, minute, second with 217 | | None, _, _, _, _ -> Error (`Msg "couldn't decode month in timestamp") 218 | | _, None, _, _, _ -> Error (`Msg "couldn't decode day in timestamp") 219 | | _, _, None, _, _ -> Error (`Msg "couldn't decode hours in timestamp") 220 | | _, _, _, None, _ -> Error (`Msg "couldn't decode minutes in timestamp") 221 | | _, _, _, _, None -> Error (`Msg "couldn't decode seconds in timestamp") 222 | | Some month, Some day, Some hour, Some min, Some sec -> 223 | match Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0)) with 224 | | None -> Error (`Msg "couldn't transform timestamp to ptime.t") 225 | | Some ts -> Ok (ts, String.sub s tslen (l - tslen)) 226 | end 227 | 228 | let to_string msg = 229 | let facility = string_of_facility msg.facility 230 | and severity = string_of_severity msg.severity 231 | and timestamp = Rfc3164_Timestamp.encode msg.timestamp 232 | in 233 | Printf.sprintf 234 | "Facility: %s Severity: %s Timestamp: %s Hostname: %s Tag: %s Content: %s\n%!" 235 | facility severity timestamp msg.hostname msg.tag msg.content 236 | 237 | let pp ppf msg = Format.pp_print_string ppf (to_string msg) 238 | 239 | let encode_gen encode ?len msg = 240 | let facse = int_of_facility msg.facility * 8 + int_of_severity msg.severity 241 | and ts = Rfc3164_Timestamp.encode msg.timestamp 242 | in 243 | let msgstr = encode facse ts msg.hostname msg.tag msg.content 244 | in 245 | match len with 246 | | None -> msgstr 247 | | Some max_len -> 248 | if String.length msgstr > max_len then 249 | String.sub msgstr 0 max_len 250 | else 251 | msgstr 252 | 253 | let is_alphanum = function 254 | | '0' .. '9' | 'A' .. 'Z' | 'a' .. 'z' -> true 255 | | _ -> false 256 | 257 | let separator s = 258 | match String.get s 0 with 259 | | exception Invalid_argument _ -> " " 260 | | c when not (is_alphanum c) -> "" 261 | | _ -> " " 262 | 263 | let encode ?len msg = 264 | let encode facse ts hostname tag content = 265 | Printf.sprintf "<%d>%s %s %s%s%s" facse ts hostname tag 266 | (separator content) content 267 | in 268 | encode_gen encode ?len msg 269 | 270 | let encode_local ?len msg = 271 | let encode facse ts _ tag content = 272 | Printf.sprintf "<%d>%s %s%s%s" facse ts tag (separator content) content 273 | in 274 | encode_gen encode ?len msg 275 | 276 | let parse_priority_value s : 277 | (facility * severity * string, [> `Msg of string ]) result = 278 | match String.split_on_char '<' s with 279 | | "" :: datas -> 280 | begin 281 | let data = String.concat "<" datas in 282 | match String.split_on_char '>' data with 283 | | pri :: datas -> 284 | begin 285 | let data = String.concat ">" datas in 286 | if String.length pri > 3 then 287 | Error (`Msg "couldn't parse priority: expected '>' earlier") 288 | else 289 | (* TODO RFC 3164 4.1.1 requires decimal, String.to_int accepts "0x1" *) 290 | match int_of_string_opt pri with 291 | | None -> Error (`Msg "couldn't parse priority: not an integer") 292 | | Some priority_value -> 293 | let facility = facility_of_int @@ priority_value / 8 294 | and severity = severity_of_int @@ priority_value mod 8 295 | in 296 | match facility, severity with 297 | | None, _ -> Error (`Msg "invalid facility") 298 | | _, None -> Error (`Msg "invalid severity") 299 | | Some facility, Some severity -> Ok (facility, severity, data) 300 | end 301 | | _ -> Error (`Msg "couldn't parse priority: no '>' found") 302 | end 303 | | _ -> Error (`Msg "couldn't parse priority: expected '<'") 304 | 305 | let parse_hostname s (ctx : ctx) : (string * string, [> `Msg of string ]) result = 306 | if ctx.set_hostname then 307 | Ok (ctx.hostname, s) 308 | else 309 | match String.split_on_char ' ' s with 310 | | host :: datas -> 311 | let data = String.concat " " datas in 312 | let* hostname = 313 | match String.split_on_char ':' host with 314 | | [ "" ] -> Error (`Msg "invalid or empty hostname") 315 | | [ host ] 316 | | [ host ; "" ] -> Ok host 317 | | _ -> Error (`Msg "invalid empty hostname") 318 | in 319 | Ok (hostname, data) 320 | | _ -> Error (`Msg "invalid or empty hostname") 321 | 322 | let parse_timestamp s (ctx : ctx) = 323 | let ((year, _, _), _) = Ptime.to_date_time ctx.timestamp in 324 | match Rfc3164_Timestamp.decode s year with 325 | | Ok (timestamp, data) -> Ok (timestamp, data, ctx) 326 | | Error _ -> 327 | let ctx = { ctx with set_hostname = true } in 328 | Ok (ctx.timestamp, s, ctx) 329 | 330 | let parse_tag s : (string * string, [> `Msg of string ]) result = 331 | let rec collect s len idx = 332 | if idx > 32 then 333 | Result.Error (`Msg "tag exceeds 32 characters") 334 | else if idx >= len then 335 | Ok (s, "") 336 | else if is_alphanum (String.get s idx) then 337 | collect s len (idx + 1) 338 | else 339 | Ok (String.sub s 0 idx, String.sub s idx (len - idx)) 340 | in 341 | collect s (String.length s) 0 342 | 343 | (* FIXME Provide default Ptime.t? Version bellow doesn't work. Option type 344 | let parse ?(ctx={timestamp=(Ptime.of_date_time ((1970, 1, 1), ((0, 0,0), 0))); hostname="-"; set_hostname=false}) data = 345 | *) 346 | let decode ~ctx data : (t, [> `Msg of string ]) result = 347 | let* facility, severity, data = parse_priority_value data in 348 | let* timestamp, data, ctx = parse_timestamp data ctx in 349 | let* hostname, data = parse_hostname data ctx in 350 | let* tag, content = parse_tag data in 351 | Ok { facility; severity; timestamp; hostname; tag; content } 352 | -------------------------------------------------------------------------------- /src/syslog_message.mli: -------------------------------------------------------------------------------- 1 | (** Syslog message parser and unparser 2 | 3 | [Syslog-message] is a module for handling syslog messages, as defined in 4 | {{:https://tools.ietf.org/html/rfc3164}RFC 3164}. 5 | 6 | The {!parse} function transforms a string to a syslog message {!t}, using a 7 | {{!ctx}context} of default parameters. Such a message can be transformed 8 | into a string {!to_string} or pretty printed {!pp_string}, {!pp}. 9 | 10 | {e %%VERSION%% - {{:%%PKG_HOMEPAGE%% }homepage}} *) 11 | 12 | (** The type for Facilities *) 13 | type facility = 14 | Kernel_Message 15 | | User_Level_Messages 16 | | Mail_System 17 | | System_Daemons 18 | | Security_Authorization_Messages 19 | | Messages_Generated_Internally_By_Syslogd 20 | | Line_Printer_Subsystem 21 | | Network_News_Subsystem 22 | | UUCP_subsystem 23 | | Clock_Daemon 24 | | Security_Authorization_Messages_10 25 | | Ftp_Daemon 26 | | Ntp_Subsystem 27 | | Log_Audit 28 | | Log_Alert 29 | | Clock_Daemon_15 30 | | Local0 31 | | Local1 32 | | Local2 33 | | Local3 34 | | Local4 35 | | Local5 36 | | Local6 37 | | Local7 38 | 39 | val int_of_facility : facility -> int 40 | val facility_of_int : int -> facility option 41 | 42 | (** [string_of_facility f] is [data], the string representation of [f]. *) 43 | val string_of_facility : facility -> string 44 | val pp_print_facility : Format.formatter -> facility -> unit 45 | 46 | (** The type for Severity levels *) 47 | type severity = 48 | Emergency 49 | | Alert 50 | | Critical 51 | | Error 52 | | Warning 53 | | Notice 54 | | Informational 55 | | Debug 56 | 57 | val int_of_severity : severity -> int 58 | val severity_of_int : int -> severity option 59 | 60 | (** [string_of_severity s] is [data], the string representation of [s]. *) 61 | val string_of_severity : severity -> string 62 | val pp_print_severity : Format.formatter -> severity -> unit 63 | 64 | (** [ctx] provides additional information to the {!val:parse} function in case one of the 65 | sub-parsers fails. 66 | - [timestamp]: A {!type:timestamp} 67 | - [hostname]: Hostname, IPv4 or IPv6 address of the sender. "{i -}" if unknown. 68 | - [set_hostname]: If true, the {!val:parse} function will skip its hostname 69 | sub-parser and use the hostname from {!type:ctx} instead. 70 | 71 | [set_hostname] is automatically set by the timestamp sub-parser when it fails, because at this 72 | point it is no longer possible to determine the hostname from the input string. *) 73 | type ctx = { 74 | timestamp : Ptime.t; 75 | hostname : string; 76 | set_hostname : bool; 77 | } 78 | 79 | (** The type for Syslog messages *) 80 | type t = { 81 | facility : facility; 82 | severity : severity; 83 | timestamp : Ptime.t; 84 | hostname : string; 85 | tag : string; 86 | content : string; 87 | } 88 | 89 | (** [pp ppf t] prints the syslog message [t] on [ppf]. *) 90 | val pp : Format.formatter -> t -> unit 91 | 92 | (** [to_string t] is [str], a pretty printed string of syslog message [t]. *) 93 | val to_string : t -> string 94 | 95 | (** [decode ~ctx data] is [t], either [Ok t], a successfully decoded 96 | syslog message, or [Error e]. *) 97 | val decode : ctx:ctx -> string -> (t, [> `Msg of string ]) result 98 | 99 | (** [encode ~len t] is [data], the encoded syslog message [t], truncated to 100 | [len] bytes. If [len] is 0 the output is not truncated. 101 | 102 | {e Warning:} Since version 1.0.0, messages are no longer truncated to 1024 103 | bytes by default. *) 104 | val encode : ?len:int -> t -> string 105 | 106 | (** [encode_local ~len t] behaves as {!encode} except that the message is 107 | formatted for sending to the local syslog daemon (e.g. on [/dev/log]). *) 108 | val encode_local : ?len:int -> t -> string 109 | 110 | (** RFC 3164 Timestamps *) 111 | module Rfc3164_Timestamp : sig 112 | 113 | (** [encode t] is [data], a timestamp in the presentation of RFC 3164. *) 114 | val encode : Ptime.t -> string 115 | 116 | (** [decode data year] is [Ok (timestamp, leftover)], the decoded RFC 3164 117 | timestamp and superfluous bytes, or [Error e] on parse failure. *) 118 | val decode : string -> int -> (Ptime.t * string, [> `Msg of string ]) result 119 | end 120 | -------------------------------------------------------------------------------- /syslog-message.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Jochen Bartl " 3 | authors: [ "Jochen Bartl " ] 4 | homepage: "https://github.com/verbosemode/syslog-message" 5 | doc: "https://verbosemode.github.io/syslog-message/doc" 6 | dev-repo: "git+https://github.com/verbosemode/syslog-message.git" 7 | bug-reports: "https://github.com/verbosemode/syslog-message/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "ocaml" {>= "4.08.0"} 12 | "dune" {>= "2.0.0"} 13 | "ptime" 14 | "qcheck" {with-test} 15 | ] 16 | 17 | build: [ 18 | [ "dune" "subst" ] {dev} 19 | [ "dune" "build" "-p" name "-j" jobs ] 20 | [ "dune" "runtest" "-p" name "-j" jobs ] {with-test} 21 | ] 22 | conflicts: [ "result" {< "1.5"} ] 23 | 24 | synopsis: "Syslog message parser" 25 | description: """ 26 | This is a library for parsing and generating [RFC3164](https://tools.ietf.org/html/rfc3164) 27 | compatible Syslog messages. 28 | """ 29 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_syslog_message) 3 | (libraries syslog-message qcheck)) 4 | -------------------------------------------------------------------------------- /test/test_syslog_message.ml: -------------------------------------------------------------------------------- 1 | open Syslog_message 2 | 3 | module QCheck_legacy = struct 4 | (* I've copied this code over from QCheck 0.4 to preserve the way, strings are 5 | * generated. 6 | * 7 | * Copyright (c) 2013, Simon Cruanes 8 | * All rights reserved. 9 | * 10 | * License (BSD): https://github.com/c-cube/qcheck/blob/6e002d5b3afbb32e364b5fa4b7e3f6e32b8d0dde/LICENSE 11 | * Source: https://github.com/c-cube/qcheck/blob/6e002d5b3afbb32e364b5fa4b7e3f6e32b8d0dde/qCheck.ml *) 12 | let alpha st = 13 | Char.chr (Char.code 'a' + Random.State.int st (Char.code 'z' - Char.code 'a')) 14 | 15 | let string_len len st = 16 | let n = len st in 17 | assert (n>=0); 18 | let b = Buffer.create n in 19 | for _i = 0 to n-1 do 20 | Buffer.add_char b (alpha st) 21 | done; 22 | Buffer.contents b 23 | 24 | let string_g = 25 | QCheck.Gen.string_size ~gen:alpha (QCheck.Gen.int_range 0 10) 26 | 27 | let string = 28 | QCheck.(string_gen_of_size (QCheck.Gen.int_range 0 10) alpha) 29 | end 30 | 31 | (* 8 severities * 23 facilities *) 32 | let priority = QCheck.int_bound 184 33 | let priority_g = QCheck.Gen.int_bound 184 34 | 35 | let ptime_g = 36 | let open QCheck.Gen in 37 | int_bound (int_of_float @@ 2. ** 29.) 38 | >|= fun n -> 39 | n 40 | |> Ptime.Span.of_int_s 41 | |> Ptime.of_span 42 | 43 | let pp_ptime = function 44 | | None -> "" 45 | | Some pt -> Rfc3164_Timestamp.encode pt 46 | 47 | let ptime = QCheck.make ~print:pp_ptime ptime_g 48 | 49 | let valid_data_succeeds = 50 | let open QCheck in 51 | Test.make ~count:100 52 | ~name:"generating valid data gets a reasonable result" 53 | (triple priority ptime QCheck_legacy.string) 54 | @@ fun (pri, pt, host) -> 55 | assume (pt <> None && String.length host > 1); 56 | match pt with 57 | | None -> false 58 | | Some pt -> 59 | let ctx = { timestamp = pt; hostname = ""; set_hostname = false } in 60 | let msg = 61 | Printf.sprintf "<%d>%s %s: Whatever" pri (Rfc3164_Timestamp.encode pt) host 62 | in 63 | match decode ~ctx msg with 64 | | Error _ -> false 65 | | Ok parsed -> 66 | let ((_, m, d), ((hh, mm, ss), _)) = Ptime.to_date_time parsed.timestamp in 67 | let ((_, m', d'), ((hh', mm', ss'), _)) = Ptime.to_date_time pt in 68 | m = m' && d = d' && hh = hh' && mm = mm' && ss = ss' && 69 | parsed.hostname = host 70 | 71 | let invalid_timestamp = 72 | let open QCheck in 73 | let pp = Print.(quad int pp_ptime string string) in 74 | Test.make ~count:100 75 | ~name:"parser substitutes the timestamp when it can't be parsed" 76 | (make ~print:pp Gen.(quad priority_g ptime_g QCheck_legacy.string_g 77 | QCheck_legacy.string_g)) 78 | @@ fun (pri, valid, invalid, host) -> 79 | assume (valid <> None); 80 | match valid with 81 | | None -> false 82 | | Some valid -> 83 | let msg = 84 | Printf.sprintf "<%d>%s %s: Whatever" pri invalid host 85 | in 86 | let ctx = { timestamp = valid; hostname = ""; set_hostname = false } in 87 | match decode ~ctx msg with 88 | | Error _ -> false 89 | | Ok parsed -> parsed.timestamp = valid 90 | 91 | let invalid_data_fails = 92 | QCheck.Test.make ~count:100 93 | ~name:"putting in invalid data always fails" 94 | QCheck.string 95 | @@ fun msg -> 96 | let ctx = { timestamp = Ptime.epoch; hostname = ""; set_hostname = false } in 97 | match decode ~ctx msg with 98 | | Error _ -> true 99 | | Ok _ -> false 100 | 101 | let () = 102 | let suite = [invalid_data_fails; valid_data_succeeds; invalid_timestamp] in 103 | QCheck_runner.run_tests_main suite 104 | --------------------------------------------------------------------------------