From 7ea86323fe0a32cea264b7ab2525f861f963edac Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 24 Aug 2024 09:23:58 -0500 Subject: [PATCH 001/151] Saturn upper bound. --- .github/opam/liquidsoap-core-windows.opam | 2 +- dune-project | 2 +- liquidsoap-lang.opam | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/opam/liquidsoap-core-windows.opam b/.github/opam/liquidsoap-core-windows.opam index e3edee5c2f..a75bcc1ddb 100644 --- a/.github/opam/liquidsoap-core-windows.opam +++ b/.github/opam/liquidsoap-core-windows.opam @@ -24,7 +24,7 @@ depends: [ "mm-windows" {>= "0.8.4"} "re-windows" {>= "1.11.0"} "cry-windows" {>= "1.0.1"} - "saturn_lockfree-windows" + "saturn_lockfree-windows" {>= "0.4.1" & < "0.5.0"} "sedlex" {>= "3.2"} "sedlex-windows" {>= "3.2"} "magic-mime-windows" diff --git a/dune-project b/dune-project index e263617e86..2835a834f7 100644 --- a/dune-project +++ b/dune-project @@ -148,7 +148,7 @@ (depends (ocaml (>= 4.14)) dune-site - (saturn_lockfree (>= 0.4.1)) + (saturn_lockfree (and (>= 0.4.1) (< 0.5.0))) (re (>= 1.11.0)) (ppx_string :build) (ppx_hash :build) diff --git a/liquidsoap-lang.opam b/liquidsoap-lang.opam index c54c135f29..e4dd268d00 100644 --- a/liquidsoap-lang.opam +++ b/liquidsoap-lang.opam @@ -11,7 +11,7 @@ depends: [ "dune" {>= "3.6"} "ocaml" {>= "4.14"} "dune-site" - "saturn_lockfree" {>= "0.4.1"} + "saturn_lockfree" {>= "0.4.1" & < "0.5.0"} "re" {>= "1.11.0"} "ppx_string" {build} "ppx_hash" {build} From 4980bc0750ae83791c471cd77b2cc6637d0f76ff Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 24 Aug 2024 10:14:48 -0500 Subject: [PATCH 002/151] Make frame slice be really at most. (#4104) --- src/core/stream/frame.ml | 2 +- tests/core/frame_test.ml | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/stream/frame.ml b/src/core/stream/frame.ml index 8ef6336941..7c98a4df5b 100644 --- a/src/core/stream/frame.ml +++ b/src/core/stream/frame.ml @@ -80,7 +80,7 @@ let create ~length content_type = let content_type = Fields.map Content.format let sub frame ofs len = Fields.map (fun c -> Content.sub c ofs len) frame -let slice frame len = sub frame 0 len +let slice frame len = sub frame 0 (min len (position frame)) let after frame offset = sub frame offset (position frame - offset) let append f f' = diff --git a/tests/core/frame_test.ml b/tests/core/frame_test.ml index 03443076dd..82eb453fd7 100644 --- a/tests/core/frame_test.ml +++ b/tests/core/frame_test.ml @@ -4,3 +4,7 @@ let () = (Frame.Fields.make ~audio:(Format_type.audio ()) ()) in Typing.(pcm_t <: Lang.univ_t ()) + +let () = + let f = Frame.create ~length:10 (Frame.Fields.from_list []) in + assert (Frame.position (Frame.slice f 20) = 10) From 17c7b0a45215864f3d85f042ae6ebb30c2beac7e Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 25 Aug 2024 12:25:20 -0500 Subject: [PATCH 003/151] Improve normalize_url option. --- src/core/builtins/builtins_http.ml | 31 ++++++++++++++++++++++++------ src/libs/http.liq | 4 ---- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/src/core/builtins/builtins_http.ml b/src/core/builtins/builtins_http.ml index ec6591e32e..8232b48a7a 100644 --- a/src/core/builtins/builtins_http.ml +++ b/src/core/builtins/builtins_http.ml @@ -24,6 +24,15 @@ type request = Get | Post | Put | Head | Delete module Http = Liq_http +let conf_http = + Dtools.Conf.void ~p:(Configure.conf#plug "http") "Settings for HTTP requests" + +let conf_normalize_url = + Dtools.Conf.bool ~d:true + ~p:(conf_http#plug "normalize_url") + "When `true`, HTTP urls are normalized by default, i.e. spaces are \ + replaced with `%20` and etc." + let string_of_request = function | Get -> "get" | Post -> "post" @@ -85,9 +94,11 @@ let add_http_request ~base ~stream_body ~descr ~request name = Some (Lang.float 10.), Some "Timeout for network operations in seconds." ); ( "normalize_url", - Lang.bool_t, - Some (Lang.bool true), - Some "Normalize url, replacing spaces with `%20` and more." ); + Lang.nullable_t Lang.bool_t, + Some Lang.null, + Some + "Normalize url, replacing spaces with `%20` and more. Defaults to \ + `settings.http.normalize_url` when `null`." ); ( "", Lang.string_t, None, @@ -122,15 +133,23 @@ let add_http_request ~base ~stream_body ~descr ~request name = Option.map Lang.to_string (Lang.to_option (List.assoc "http_version" p)) in let original_url = Lang.to_string (List.assoc "" p) in - let normalize_url = Lang.to_bool (List.assoc "normalize_url" p) in + let normalize_url = + Option.value ~default:conf_normalize_url#get + (Lang.to_valued_option Lang.to_bool (List.assoc "normalize_url" p)) + in let url = if normalize_url then Uri.(to_string (of_string original_url)) else original_url in if Uri.pct_decode url <> original_url then log#important - "Requested url %s different from normalized url: %s. Either fix it \ - or use `normalize_url=false` to disable url normalization!" + "Requested url %s is different from normalized url: %s. URL are \ + normalized by default to ensure maximum compatibility with e.g. \ + URLs with spaces in them. However, this can also cause issues so we \ + recommend passing normalized URLs. Url normalization can be \ + disabled on a case-by-case basis using the `normalize_url=false` \ + parameter or globally using the `settings.http.normalize_url` \ + setting." (Lang_string.quote_utf8_string original_url) (Lang_string.quote_utf8_string (Uri.pct_decode url)); let redirect = Lang.to_bool (List.assoc "redirect" p) in diff --git a/src/libs/http.liq b/src/libs/http.liq index 1aea2a3da9..8f9a016eb1 100644 --- a/src/libs/http.liq +++ b/src/libs/http.liq @@ -802,10 +802,6 @@ def http.put.file( end let harbor.http.request = () -let settings.http = - settings.make.void( - "Settings for HTTP requests" - ) let settings.http.mime = settings.make.void( "MIME-related settings for HTTP requests" From 893690d78fbf255dbc43d8598eec306716eafa45 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 25 Aug 2024 12:28:24 -0500 Subject: [PATCH 004/151] Improve. --- src/core/builtins/builtins_http.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/builtins/builtins_http.ml b/src/core/builtins/builtins_http.ml index 8232b48a7a..3d0e5880de 100644 --- a/src/core/builtins/builtins_http.ml +++ b/src/core/builtins/builtins_http.ml @@ -147,7 +147,7 @@ let add_http_request ~base ~stream_body ~descr ~request name = normalized by default to ensure maximum compatibility with e.g. \ URLs with spaces in them. However, this can also cause issues so we \ recommend passing normalized URLs. Url normalization can be \ - disabled on a case-by-case basis using the `normalize_url=false` \ + disabled on a case-by-case basis using the `normalize_url` \ parameter or globally using the `settings.http.normalize_url` \ setting." (Lang_string.quote_utf8_string original_url) From 3b4b9a7bce7fa1a12c546cc3a74f11f9bb5585ea Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 25 Aug 2024 17:06:18 -0500 Subject: [PATCH 005/151] Take encoding into account in `string` functions. (#4111) --- CHANGES.md | 2 + doc/content/migrating.md | 8 ++ src/core/builtins/builtins_string_extra.ml | 26 +++++ src/lang/builtins_regexp.ml | 2 +- src/lang/builtins_string.ml | 114 ++++++++++++++++++--- src/lang/lang_string.ml | 22 ++-- src/lang/lang_string.mli | 10 +- src/libs/extra/audio.liq | 4 +- src/libs/file.liq | 13 +-- src/libs/http.liq | 13 +-- src/libs/protocols.liq | 2 +- src/libs/string.liq | 70 +++++++++---- tests/harbor/http.liq | 10 +- tests/language/string.liq | 32 ++++++ tests/regression/GH3675.liq | 2 +- 15 files changed, 268 insertions(+), 62 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index b77453bced..d9c7cf460a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -53,6 +53,7 @@ New: - Add `string.of_int` and `string.spaces`. - Add `list.assoc.nullable`. - Add `source.cue` (#3620). +- Add `string.chars` (#4111) - Added atomic file write operations. Changed: @@ -64,6 +65,7 @@ Changed: - Changed internal metadata format to be immutable (#3297). - Allow a getter for the offset of `on_offset` and dropped the metadata mechanism for updating it (#3355). +- `string.length` and `string.sub` now default to `utf8` encoding (#4109) - Disable output paging when `TERM` environment variable is not set. - Allow running as `root` user inside `docker` container by default (#3406). - Run `check_next` before playlist's requests resolutions (#3625) diff --git a/doc/content/migrating.md b/doc/content/migrating.md index 445cb42828..e884f591ec 100644 --- a/doc/content/migrating.md +++ b/doc/content/migrating.md @@ -92,6 +92,14 @@ end However, EBU R128 data is now extracted directly from metadata when available. So `replaygain` cannot control the gain type via this parameter anymore. +### String functions + +Some string functions have been updated to account for string encoding. In particular, `string.length` and `string.sub` now assume that their +given string is in `utf8` by default. + +While this is what most user expect, this can lead to backward incompatibilities and new exceptions. You can change back to the old default by +passing `encoding="ascii"` to these functions or using the `settings.string.default_encoding` settings. + ### `check_next` `check_next` in playlist operators is now called _before_ the request is resolved, to make it possible to cut out diff --git a/src/core/builtins/builtins_string_extra.ml b/src/core/builtins/builtins_string_extra.ml index 21a8452ceb..99091b0d1a 100644 --- a/src/core/builtins/builtins_string_extra.ml +++ b/src/core/builtins/builtins_string_extra.ml @@ -20,6 +20,32 @@ *****************************************************************************) +let log = Log.make ["lang"; "string"] + +let conf_string = + Dtools.Conf.void ~p:(Configure.conf#plug "string") "String settings" + +let () = + let conf_default_encoding = + Dtools.Conf.string + ~p:(conf_string#plug "default_encoding") + ~d:"utf8" + "Default encoding for `string.length`, `string.chars` and `string.sub`" + in + conf_default_encoding#on_change (fun v -> + let enc = + match v with + | "ascii" -> `Ascii + | "utf8" -> `Utf8 + | _ -> + log#important + "Invalid value %s for `settings.string.default_encoding`! \ + Should be one of: \"ascii\" or \"utf8\"." + v; + `Utf8 + in + Liquidsoap_lang.Builtins_string.default_encoding := enc) + let string = Liquidsoap_lang.Builtins_string.string let string_annotate = Lang.add_module ~base:string "annotate" diff --git a/src/lang/builtins_regexp.ml b/src/lang/builtins_regexp.ml index f8855d08db..4358aa0da6 100644 --- a/src/lang/builtins_regexp.ml +++ b/src/lang/builtins_regexp.ml @@ -49,7 +49,7 @@ let escape_regex_descr = else Lang_string.utf8_special_char s pos len) ~escape_char:(fun s pos len -> if s.[pos] = '/' && len = 1 then "\\/" - else Lang_string.escape_utf8_char s pos len) + else Lang_string.escape_utf8_char ~strict:false s pos len) ~next:Lang_string.utf8_next in Lang_string.escape_string escape_regex_formatter diff --git a/src/lang/builtins_string.ml b/src/lang/builtins_string.ml index 9177afbb0b..359790a18b 100644 --- a/src/lang/builtins_string.ml +++ b/src/lang/builtins_string.ml @@ -52,6 +52,86 @@ let _ = let l = List.map Lang.to_string l in Lang.string (String.concat sep l)) +let split ~encoding s = + let buf = Buffer.create 1 in + let to_string add c = + Buffer.clear buf; + add buf c; + Buffer.contents buf + in + let get = + match encoding with + | `Ascii -> fun pos -> (to_string Buffer.add_char (String.get s pos), 1) + | `Utf8 -> + fun pos -> + let d = String.get_utf_8_uchar s pos in + if not (Uchar.utf_decode_is_valid d) then + failwith "Decoding failed!"; + ( to_string Buffer.add_utf_8_uchar (Uchar.utf_decode_uchar d), + Uchar.utf_decode_length d ) + in + let len = String.length s in + let rec f chars pos = + if pos = len then List.rev chars + else ( + let char, len = get pos in + f (char :: chars) (pos + len)) + in + f [] 0 + +let default_encoding = ref `Utf8 + +let encoding_option = + ( "encoding", + Lang.nullable_t Lang.string_t, + Some Lang.null, + Some + "Encoding used to split characters. Should be one of: `\"utf8\"` or \ + `\"ascii\"`" ) + +let get_encoding p = + match Lang.to_valued_option Lang.to_string (List.assoc "encoding" p) with + | None -> ("utf8", !default_encoding) + | Some "utf8" -> ("utf8", `Utf8) + | Some "ascii" -> ("ascii", `Ascii) + | _ -> + Runtime_error.raise ~pos:(Lang.pos p) ~message:"Invalid encoding!" + "invalid" + +let _ = + Lang.add_builtin ~base:string "chars" ~category:`String + ~descr:"Split string into characters. Raises `error.invalid` on errors." + [encoding_option; ("", Lang.string_t, None, None)] + (Lang.list_t Lang.string_t) + (fun p -> + let enc, encoding = get_encoding p in + let s = Lang.to_string (List.assoc "" p) in + try Lang.list (List.map Lang.string (split ~encoding s)) + with _ -> + Runtime_error.raise ~pos:(Lang.pos p) + ~message: + (Printf.sprintf "String cannot be split using encoding `\"%s\"`!" + enc) + "invalid") + +let _ = + Lang.add_builtin ~base:string "length" ~category:`String + ~descr: + "Return the string's length using the given encoding. Raises \ + `error.invalid` on errors." + [encoding_option; ("", Lang.string_t, None, None)] + Lang.int_t + (fun p -> + let enc, encoding = get_encoding p in + let s = Lang.to_string (List.assoc "" p) in + try Lang.int (List.length (split ~encoding s)) + with _ -> + Runtime_error.raise ~pos:(Lang.pos p) + ~message: + (Printf.sprintf "String cannot be split using encoding `\"%s\"`!" + enc) + "invalid") + let _ = Lang.add_builtin ~base:string "nth" ~category:`String ~descr: @@ -165,7 +245,7 @@ let string_escape = ("", Lang.string (String.sub s ofs len)); ]) | None, `Ascii -> Lang_string.escape_hex_char - | None, `Utf8 -> Lang_string.escape_utf8_char + | None, `Utf8 -> Lang_string.escape_utf8_char ~strict:false in let next = match encoding with @@ -213,7 +293,8 @@ let _ = match Lang.to_string format with | "octal" -> (Lang_string.escape_octal_char, Lang_string.ascii_next) | "hex" -> (Lang_string.escape_hex_char, Lang_string.ascii_next) - | "utf8" -> (Lang_string.escape_utf8_char, Lang_string.utf8_next) + | "utf8" -> + (Lang_string.escape_utf8_char ~strict:false, Lang_string.utf8_next) | _ -> raise (Error.Invalid_value @@ -264,15 +345,6 @@ let _ = let s = Lang.to_string (List.assoc "" p) in Lang.string (Lang_string.unescape_string s)) -let _ = - Lang.add_builtin ~base:string "length" ~category:`String - ~descr:"Get the length of a string." - [("", Lang.string_t, None, None)] - Lang.int_t - (fun p -> - let string = Lang.to_string (List.assoc "" p) in - Lang.int (String.length string)) - let _ = Lang.add_builtin ~base:string "sub" ~category:`String ~descr: @@ -285,6 +357,7 @@ let _ = Some "Return a sub string starting at this position. First position is 0." ); + encoding_option; ( "length", Lang.int_t, None, @@ -294,9 +367,24 @@ let _ = (fun p -> let start = Lang.to_int (List.assoc "start" p) in let len = Lang.to_int (List.assoc "length" p) in + let _, encoding = get_encoding p in let string = Lang.to_string (List.assoc "" p) in - Lang.string - (try String.sub string start len with Invalid_argument _ -> "")) + let s = + match encoding with + | `Ascii -> ( + try String.sub string start len with Invalid_argument _ -> "") + | `Utf8 -> ( + try + let chars = split ~encoding string in + if List.length chars < len + start then "" + else + String.concat "" + (List.filteri + (fun pos _ -> start <= pos && pos < start + len) + chars) + with _ -> "") + in + Lang.string s) let _ = Lang.add_builtin ~base:string "index" ~category:`String diff --git a/src/lang/lang_string.ml b/src/lang/lang_string.ml index 296a21a724..6147d5c0c3 100644 --- a/src/lang/lang_string.ml +++ b/src/lang/lang_string.ml @@ -105,15 +105,17 @@ let escape_char ~escape_fun s pos len = | '\'', 1 -> "\\'" | _ -> escape_fun s pos len -let escape_utf8_char = +let escape_utf8_char ~strict = let utf8_char_code s pos len = - try utf8_char_code s pos len with _ -> Uchar.to_int Uchar.rep + try utf8_char_code s pos len + with _ when not strict -> Uchar.to_int Uchar.rep in escape_char ~escape_fun:(fun s pos len -> Printf.sprintf "\\u%04X" (utf8_char_code s pos len)) -let escape_utf8_formatter ?(special_char = utf8_special_char) = - escape ~special_char ~escape_char:escape_utf8_char ~next:utf8_next +let escape_utf8_formatter ?(strict = false) ?(special_char = utf8_special_char) + = + escape ~special_char ~escape_char:(escape_utf8_char ~strict) ~next:utf8_next let escape_hex_char = escape_char ~escape_fun:(fun s pos len -> @@ -153,15 +155,15 @@ let escape_string escape s = len segments); Bytes.unsafe_to_string b) -let escape_utf8_string ?special_char = - escape_string (escape_utf8_formatter ?special_char) +let escape_utf8_string ?strict ?special_char = + escape_string (escape_utf8_formatter ?strict ?special_char) let escape_ascii_string ?special_char = escape_string (escape_ascii_formatter ?special_char) -let quote_utf8_string s = +let quote_utf8_string ?strict s = Printf.sprintf "\"%s\"" - (escape_utf8_string + (escape_utf8_string ?strict ~special_char:(fun s pos len -> if s.[pos] = '\'' && len = 1 then false else utf8_special_char s pos len) @@ -175,7 +177,9 @@ let quote_ascii_string s = else ascii_special_char s pos len) s) -let quote_string s = try quote_utf8_string s with _ -> quote_ascii_string s +let quote_string s = + try quote_utf8_string ~strict:true s with _ -> quote_ascii_string s + let unescape_utf8_pattern = "\\\\u[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]" let unescape_hex_pattern = "\\\\x[0-9a-fA-F][0-9a-fA-F]" let unescape_octal_pattern = "\\\\[0-9][0-9][0-9]" diff --git a/src/lang/lang_string.mli b/src/lang/lang_string.mli index f4bea8db2f..a0d3f16009 100644 --- a/src/lang/lang_string.mli +++ b/src/lang/lang_string.mli @@ -16,9 +16,10 @@ val ascii_next : 'a -> int -> int val escape_char : escape_fun:(string -> int -> int -> string) -> string -> int -> int -> string -val escape_utf8_char : string -> int -> int -> string +val escape_utf8_char : strict:bool -> string -> int -> int -> string val escape_utf8_formatter : + ?strict:bool -> ?special_char:(string -> int -> int -> bool) -> string -> [> `Orig of int * int | `Subst of string * int ] list * int @@ -39,12 +40,15 @@ val escape_string : string val escape_utf8_string : - ?special_char:(string -> int -> int -> bool) -> string -> string + ?strict:bool -> + ?special_char:(string -> int -> int -> bool) -> + string -> + string val escape_ascii_string : ?special_char:(string -> int -> int -> bool) -> string -> string -val quote_utf8_string : string -> string +val quote_utf8_string : ?strict:bool -> string -> string val quote_ascii_string : string -> string val quote_string : string -> string val unescape_utf8_pattern : string diff --git a/src/libs/extra/audio.liq b/src/libs/extra/audio.liq index 1b1d465636..1b5213f12f 100644 --- a/src/libs/extra/audio.liq +++ b/src/libs/extra/audio.liq @@ -303,9 +303,9 @@ end def replaces dtmf(~duration=0.1, ~delay=0.05, dtmf) = l = ref([]) for i = 0 to - string.length(dtmf) - 1 + string.length(encoding="ascii", dtmf) - 1 do - c = string.sub(dtmf, start=i, length=1) + c = string.sub(encoding="ascii", dtmf, start=i, length=1) let (row, col) = if c == "1" diff --git a/src/libs/file.liq b/src/libs/file.liq index 9343da24da..d6c51274d1 100644 --- a/src/libs/file.liq +++ b/src/libs/file.liq @@ -260,7 +260,8 @@ def file.metadata.flac.cover.decode(s) = def read_int() = ret = string.binary.to_int( - little_endian=false, string.sub(s, start=i(), length=4) + little_endian=false, + string.sub(encoding="ascii", s, start=i(), length=4) ) i := i() + 4 @@ -268,7 +269,7 @@ def file.metadata.flac.cover.decode(s) = end def read_string(len) = - ret = string.sub(s, start=i(), length=len) + ret = string.sub(encoding="ascii", s, start=i(), length=len) i := i() + len (ret : string) end @@ -284,7 +285,7 @@ def file.metadata.flac.cover.decode(s) = number_of_colors = read_int() number_of_colors = number_of_colors > 0 ? null(number_of_colors) : null() data_len = read_int() - data = string.sub(s, start=i(), length=data_len) + data = string.sub(encoding="ascii", s, start=i(), length=data_len) if data == "" then @@ -320,10 +321,10 @@ def file.metadata.flac.cover.encode( data ) = def encode_string(s) = - len = 1 + (string.length(s) / 8) + len = 1 + (string.length(encoding="ascii", s) / 8) str_len = string.binary.of_int(little_endian=false, pad=4, len) if - string.length(str_len) > 4 + string.length(encoding="ascii", str_len) > 4 then error.raise( error.invalid, @@ -331,7 +332,7 @@ def file.metadata.flac.cover.encode( ) end - pad = string.make(char_code=0, len * 8 - string.length(s)) + pad = string.make(char_code=0, len * 8 - string.length(encoding="ascii", s)) (str_len, "#{s}#{pad}") end diff --git a/src/libs/http.liq b/src/libs/http.liq index 8f9a016eb1..a9fe3eef8f 100644 --- a/src/libs/http.liq +++ b/src/libs/http.liq @@ -180,8 +180,9 @@ def http.response( getter.get(data) else data = getter.get(data) + len = string.length(encoding="ascii", data) response_ended := data == "" - "#{string.hex_of_int(string.length(data))}\r\n#{data}\r\n" + "#{string.hex_of_int(len)}\r\n#{data}\r\n" end end @@ -307,7 +308,7 @@ end # @flag hidden def harbor.http.regexp_of_path(path) = def named_capture(s) = - name = string.sub(s, start=1, length=string.length(s) - 1) + name = string.sub(encoding="ascii", s, start=1, length=string.length(encoding="ascii", s) - 1) "(?<#{name}>[^/]+)" end @@ -500,7 +501,7 @@ def harbor.http.static.base( directory = path.home.unrelate(directory) basepath = if - string.sub(basepath, start=0, length=1) != "/" + string.sub(encoding="ascii", basepath, start=0, length=1) != "/" then "/#{basepath}" else @@ -509,7 +510,7 @@ def harbor.http.static.base( basepath = if - string.sub(basepath, start=string.length(basepath) - 1, length=1) != "/" + string.sub(encoding="ascii", basepath, start=string.length(encoding="ascii", basepath) - 1, length=1) != "/" then basepath ^ "/" else @@ -584,8 +585,8 @@ end # @flag hidden def http.string_of_float(x) = s = string(x) - n = string.length(s) - if string.sub(s, start=n - 1, length=1) == "." then s ^ "0" else s end + n = string.length(encoding="ascii", s) + if string.sub(encoding="ascii", s, start=n - 1, length=1) == "." then s ^ "0" else s end end # @flag hidden diff --git a/src/libs/protocols.liq b/src/libs/protocols.liq index b3f448268f..67d1afe240 100644 --- a/src/libs/protocols.liq +++ b/src/libs/protocols.liq @@ -429,7 +429,7 @@ def protocol.ffmpeg(~rlog, ~maxtime, arg) = end m = string.concat(separator=",", list.map(f, m)) - if string.length(m) > 0 then "annotate:#{m}:" else "" end + if string.length(encoding="ascii", m) > 0 then "annotate:#{m}:" else "" end end def parse_metadata(file) = diff --git a/src/libs/string.liq b/src/libs/string.liq index 4679bbe62b..a03310aa4f 100644 --- a/src/libs/string.liq +++ b/src/libs/string.liq @@ -37,9 +37,9 @@ end # Split a string in two at first "separator". # @category String -def string.split.first(~separator, s) = - n = string.length(s) - l = string.length(separator) +def string.split.first(~encoding=null(), ~separator, s) = + n = string.length(encoding=encoding, s) + l = string.length(encoding=encoding, separator) i = string.index(substring=separator, s) if i < 0 @@ -51,44 +51,72 @@ def string.split.first(~separator, s) = end ( - string.sub(s, start=0, length=i), - string.sub(s, start=i + l, length=n - (i + l)) + string.sub(encoding=encoding, s, start=0, length=i), + string.sub(encoding=encoding, s, start=i + l, length=n - (i + l)) ) end # Test whether a string contains a given prefix, substring or suffix. # @category String +# @param ~encoding Encoding used to split characters. Should be one of: `"utf8"` or `"ascii"` # @param ~prefix Prefix to look for. # @param ~substring Substring to look for. # @param ~suffix Suffix to look for. # @param s The string to look into. -def string.contains(~prefix="", ~substring="", ~suffix="", s) = +def string.contains( + ~encoding=null(), + ~prefix="", + ~substring="", + ~suffix="", + s +) = ans = ref(prefix == "" and substring == "" and suffix == "") if prefix != "" then ans := - ans() or string.sub(s, start=0, length=string.length(prefix)) == prefix + ans() + or + + string.sub( + encoding=encoding, + s, + start=0, + length=string.length(encoding=encoding, prefix) + ) == + prefix + end if suffix != "" then - suflen = string.length(suffix) + suflen = string.length(encoding=encoding, suffix) ans := ans() or - string.sub(s, start=string.length(s) - suflen, length=suflen) == suffix + + string.sub( + encoding=encoding, + s, + start=string.length(encoding=encoding, s) - suflen, + length=suflen + ) == + suffix + end if substring != "" then - sublen = string.length(substring) + sublen = string.length(encoding=encoding, substring) for i = 0 to - string.length(s) - sublen + string.length(encoding=encoding, s) - sublen do - ans := ans() or (string.sub(s, start=i, length=sublen) == substring) + ans := + ans() + or + (string.sub(encoding=encoding, s, start=i, length=sublen) == substring) end end @@ -97,13 +125,19 @@ end # What remains of a string after a given prefix. # @category String +# @param ~encoding Encoding used to split characters. Should be one of: `"utf8"` or `"ascii"` # @param ~prefix Requested prefix. -def string.residual(~prefix, s) = - n = string.length(prefix) +def string.residual(~encoding=null(), ~prefix, s) = + n = string.length(encoding=encoding, prefix) if - string.contains(prefix=prefix, s) + string.contains(encoding=encoding, prefix=prefix, s) then - string.sub(s, start=n, length=string.length(s) - n) + string.sub( + encoding=encoding, + s, + start=n, + length=string.length(encoding=encoding, s) - n + ) else null() end @@ -155,7 +189,7 @@ let string.binary = () # @param s String containing the binary representation. def string.binary.to_int(~little_endian=true, s) = ans = ref(0) - n = string.length(s) + n = string.length(encoding="ascii", s) for i = 0 to n - 1 do @@ -191,7 +225,7 @@ def string.binary.of_int(~pad=0, ~little_endian=true, d) = ret = d == 0 ? "\\x00" : f(d, "") ret = string.unescape(ret) - len = string.length(ret) + len = string.length(encoding="ascii", ret) if len < pad then diff --git a/tests/harbor/http.liq b/tests/harbor/http.liq index 7e62242846..135cd9fe78 100644 --- a/tests/harbor/http.liq +++ b/tests/harbor/http.liq @@ -134,7 +134,7 @@ def f() = ) test.equal(req.path, "/large_non_chunked") - test.equal(string.length(req.body(timeout=5.0)), 10_000) + test.equal(string.length(encoding="ascii", req.body(timeout=5.0)), 10_000) end harbor.http.register("/large_non_chunked", method="POST", port=3456, handler) @@ -213,7 +213,13 @@ def f() = def rec f(count) = ret = req.data() - if ret != "" then f(count + string.length(ret)) else count end + if + ret != "" + then + f(count + string.length(encoding="ascii", ret)) + else + count + end end test.equal(f(0), 10_000_000) diff --git a/tests/language/string.liq b/tests/language/string.liq index 1e3e0a1421..0e0c55977c 100755 --- a/tests/language/string.liq +++ b/tests/language/string.liq @@ -143,6 +143,37 @@ def f() = "blo#{(1, 2, 3)}", "blo(1, 2, 3)" ) + + s = "王^小東=" + test.equal(string.length(s), 5) + test.equal(string.chars(s), ["王", "^", "小", "東", "="]) + test.equal(string.sub(start=1, length=2, s), "^小") + test.equal(string.length(encoding="ascii", s), 11) + test.equal( + string.chars(encoding="ascii", s), + [ + "\xE7", + "\x8E", + "\x8B", + "^", + "\xE5", + "\xB0", + "\x8F", + "\xE6", + "\x9D", + "\xB1", + "=" + ] + ) + test.equal(string.sub(encoding="ascii", start=1, length=2, s), "\x8E\x8B") + + try + string.chars(encoding="utf16le", s) + test.fail() + catch e : [error.invalid] do + () + end + test.pass() end @@ -171,6 +202,7 @@ def test_escape_html() = test.equal(string.escape.html("\\"), "\\") test.equal(string.escape.html("/"), "/") test.equal(string.escape.html("`"), "`") + test.pass() end diff --git a/tests/regression/GH3675.liq b/tests/regression/GH3675.liq index 13947b1a46..64e7afaaf1 100644 --- a/tests/regression/GH3675.liq +++ b/tests/regression/GH3675.liq @@ -17,7 +17,7 @@ def reopen_when() = fd.close() if - string.sub(s, start=0, length=4) != "RIFF" + string.sub(encoding="ascii", s, start=0, length=4) != "RIFF" then test.fail() else From 97dad9a5183f137cced07e4b8ebbed4e29b40e62 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 25 Aug 2024 21:42:47 -0500 Subject: [PATCH 006/151] Generate cache during package install (#4113) --- .github/alpine/APKBUILD-minimal.in | 2 +- .github/alpine/APKBUILD.in | 2 +- ...{liquidsoap.pre-install => liquidsoap.post-install} | 7 ++++++- .github/debian/postinst | 10 +++++++--- .github/scripts/build-apk.sh | 4 ++-- 5 files changed, 17 insertions(+), 8 deletions(-) rename .github/alpine/{liquidsoap.pre-install => liquidsoap.post-install} (59%) diff --git a/.github/alpine/APKBUILD-minimal.in b/.github/alpine/APKBUILD-minimal.in index 9a9fa1710b..906ed43713 100644 --- a/.github/alpine/APKBUILD-minimal.in +++ b/.github/alpine/APKBUILD-minimal.in @@ -5,7 +5,7 @@ pkgdesc="Swiss-army knife for multimedia streaming" url="https://github.com/savonet/liquidsoap" arch="all" license="GPL-2.0-only" -install="@APK_PACKAGE@.pre-install" +install="@APK_PACKAGE@.post-install" options="!check textrels" package() { diff --git a/.github/alpine/APKBUILD.in b/.github/alpine/APKBUILD.in index 7d563c172c..57bba080e1 100644 --- a/.github/alpine/APKBUILD.in +++ b/.github/alpine/APKBUILD.in @@ -5,7 +5,7 @@ pkgdesc="Swiss-army knife for multimedia streaming" url="https://github.com/savonet/liquidsoap" arch="all" license="GPL-2.0-only" -install="@APK_PACKAGE@.pre-install" +install="@APK_PACKAGE@.post-install" options="!check textrels" depends="sdl2 sdl2_image sdl2_ttf" diff --git a/.github/alpine/liquidsoap.pre-install b/.github/alpine/liquidsoap.post-install similarity index 59% rename from .github/alpine/liquidsoap.pre-install rename to .github/alpine/liquidsoap.post-install index fe0c259c9d..11817ec1fa 100755 --- a/.github/alpine/liquidsoap.pre-install +++ b/.github/alpine/liquidsoap.post-install @@ -5,7 +5,12 @@ adduser -S -D -h /var/liquidsoap -s /sbin/nologin -G liquidsoap -g liquidsoap li addgroup liquidsoap audio 2> /dev/null mkdir -p /var/log/liquidsoap mkdir -p /var/cache/liquidspap -chown liquidsoap:liquidsoap /var/log/liquidsoap + +echo "Generating cache for the standard library.." +LIQ_CACHE_SYSTEM_DIR=/var/cache/liquidsoap liquidsoap --cache-only '()' + +chown -R liquidsoap:liquidsoap /var/log/liquidsoap chown liquidsoap:liquidsoap /var/cache/liquidsoap +chmod -R +r /var/cache/liquidsoap exit 0 diff --git a/.github/debian/postinst b/.github/debian/postinst index 2a3bf33e60..d9e0720a40 100644 --- a/.github/debian/postinst +++ b/.github/debian/postinst @@ -35,10 +35,14 @@ if ! test -d /var/cache/liquidsoap; then mkdir -p /var/cache/liquidsoap fi +echo "Generating cache for the standard library.." +LIQ_CACHE_SYSTEM_DIR=/var/cache/liquidsoap liquidsoap --cache-only '()' + # Fix directories ownership -chown liquidsoap:liquidsoap /var/log/liquidsoap -chown liquidsoap:liquidsoap /var/cache/liquidsoap -chown root:root /usr/share/liquidsoap +chown -R liquidsoap:liquidsoap /var/log/liquidsoap +chmod -R +r /var/log/liquidsoap +chown -R liquidsoap:liquidsoap /var/cache/liquidsoap +chown -R root:root /usr/share/liquidsoap #DEBHELPER# diff --git a/.github/scripts/build-apk.sh b/.github/scripts/build-apk.sh index 6866f0a096..2cb5dd00db 100755 --- a/.github/scripts/build-apk.sh +++ b/.github/scripts/build-apk.sh @@ -37,7 +37,7 @@ sed -e "s#@APK_PACKAGE@#${APK_PACKAGE}#" liquidsoap/.github/alpine/APKBUILD.in | sed -e "s#@APK_RELEASE@#${APK_RELEASE}#" \ > APKBUILD -cp "liquidsoap/.github/alpine/liquidsoap.pre-install" "${APK_PACKAGE}.pre-install" +cp "liquidsoap/.github/alpine/liquidsoap.post-install" "${APK_PACKAGE}.post-install" abuild-keygen -a -n abuild @@ -83,7 +83,7 @@ sed -e "s#@APK_PACKAGE@#${APK_PACKAGE}-minimal#" liquidsoap/.github/alpine/APKBU sed -e "s#@APK_RELEASE@#${APK_RELEASE}#" \ > APKBUILD -cp "liquidsoap/.github/alpine/liquidsoap.pre-install" "${APK_PACKAGE}-minimal.pre-install" +cp "liquidsoap/.github/alpine/liquidsoap.post-install" "${APK_PACKAGE}-minimal.post-install" abuild-keygen -a -n abuild From 59de576ec1ac9ab17d78e563f60ab72340c4daec Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 26 Aug 2024 18:11:39 -0500 Subject: [PATCH 007/151] switch: don't select the same source twice. (#4108) --- src/core/operators/switch.ml | 13 ++++++++++--- src/core/source.ml | 1 + 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/core/operators/switch.ml b/src/core/operators/switch.ml index 7d705548df..c860ddc9af 100644 --- a/src/core/operators/switch.ml +++ b/src/core/operators/switch.ml @@ -89,6 +89,12 @@ class switch ~all_predicates ~override_meta ~transition_length ~replay_meta val mutable transition_length = transition_length val mutable selected : selection option = None + (* We cannot reselect the same source twice during a streaming cycle. *) + val mutable excluded_sources = [] + + initializer + self#on_before_streaming_cycle (fun () -> excluded_sources <- []) + method private is_selected_generated = match selected with | None -> false @@ -96,18 +102,18 @@ class switch ~all_predicates ~override_meta ~transition_length ~replay_meta source != effective_source method private select ~reselect () = - let may_reselect ~single s = + let may_select ~single s = match selected with | Some { child; effective_source } when child.source == s.source -> (not single) && self#can_reselect ~reselect effective_source - | _ -> true + | _ -> not (List.memq s excluded_sources) in try Some (pick_selection (find ~strict:all_predicates (fun (d, single, s) -> - satisfied d && may_reselect ~single s && s.source#is_ready) + satisfied d && may_select ~single s && s.source#is_ready) children)) with Not_found -> None @@ -218,6 +224,7 @@ class switch ~all_predicates ~override_meta ~transition_length ~replay_meta end; match selected with | Some s when s.effective_source#is_ready -> + excluded_sources <- s.child :: excluded_sources; Some s.effective_source | _ -> None) diff --git a/src/core/source.ml b/src/core/source.ml index 1766b888d6..7883e4e574 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -631,6 +631,7 @@ class virtual generate_from_multiple_sources ~merge ~track_sensitive () = | Some s' when last_source == s' -> let remainder = s#get_partial_frame (fun frame -> + assert (last_chunk_pos < Frame.position frame); Frame.slice frame (last_chunk_pos + rem)) in let new_track = Frame.after remainder last_chunk_pos in From 3e3ceaa958d2f678ecd32f370ae535b923c78d44 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 2 Sep 2024 10:12:22 -0700 Subject: [PATCH 008/151] Add regression test for #4116 (#4120) --- tests/regression/GH4116.liq | 10 +++++ tests/regression/dune | 17 ++++++++ tests/regression/dune.inc | 84 ++++++++++++++++++++++++++++++++++++ tests/regression/gen_dune.ml | 1 + 4 files changed, 112 insertions(+) create mode 100644 tests/regression/GH4116.liq diff --git a/tests/regression/GH4116.liq b/tests/regression/GH4116.liq new file mode 100644 index 0000000000..c6d655324e --- /dev/null +++ b/tests/regression/GH4116.liq @@ -0,0 +1,10 @@ +s = single("./theora-test.mp4") + +enc = %theora + +tmp = file.temp("foo", "ogg") +on_cleanup({file.remove(tmp)}) + +output.file(fallible=true, enc, tmp, s) + +thread.run(delay=2., test.pass) diff --git a/tests/regression/dune b/tests/regression/dune index 75a53f6e3c..a832ed0974 100644 --- a/tests/regression/dune +++ b/tests/regression/dune @@ -50,3 +50,20 @@ (pipe-stdout (echo "print(123)") (run %{run_test} "stdin script" liquidsoap --check "-")))) + +(rule + (alias citest) + (package liquidsoap) + (target theora-test.mp4) + (action + (run + ffmpeg + -f + lavfi + -i + testsrc=duration=10:size=1280x720:rate=30 + -f + lavfi + -i + "sine=frequency=1000:duration=10" + %{target}))) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index 0a4160799b..61353c7d72 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -8,6 +8,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -23,6 +24,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -38,6 +40,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -53,6 +56,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -68,6 +72,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -83,6 +88,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -98,6 +104,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -113,6 +120,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -128,6 +136,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -143,6 +152,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -158,6 +168,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -173,6 +184,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -188,6 +200,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -203,6 +216,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -218,6 +232,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -233,6 +248,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -248,6 +264,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -263,6 +280,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -278,6 +296,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -293,6 +312,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -308,6 +328,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -323,6 +344,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -338,6 +360,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -353,6 +376,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -368,6 +392,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -383,6 +408,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -398,6 +424,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -413,6 +440,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -428,6 +456,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -443,6 +472,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -458,6 +488,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -473,6 +504,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -488,6 +520,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -503,6 +536,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -518,6 +552,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -533,6 +568,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -548,6 +584,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -563,6 +600,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -578,6 +616,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -593,6 +632,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -608,6 +648,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -623,12 +664,29 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) (:run_test ../run_test.exe)) (action (run %{run_test} GH4090.liq liquidsoap %{test_liq} GH4090.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + GH4116.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} GH4116.liq liquidsoap %{test_liq} GH4116.liq))) + (rule (alias citest) (package liquidsoap) @@ -638,6 +696,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -653,6 +712,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -668,6 +728,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -683,6 +744,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -698,6 +760,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -713,6 +776,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -728,6 +792,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -743,6 +808,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -758,6 +824,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -773,6 +840,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -788,6 +856,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -803,6 +872,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -818,6 +888,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -833,6 +904,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -848,6 +920,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -863,6 +936,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -878,6 +952,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -893,6 +968,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -908,6 +984,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -923,6 +1000,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -938,6 +1016,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -953,6 +1032,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -968,6 +1048,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -983,6 +1064,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -998,6 +1080,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) @@ -1013,6 +1096,7 @@ ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) diff --git a/tests/regression/gen_dune.ml b/tests/regression/gen_dune.ml index 058952f224..2a8e56d10a 100644 --- a/tests/regression/gen_dune.ml +++ b/tests/regression/gen_dune.ml @@ -18,6 +18,7 @@ let () = ../../src/bin/liquidsoap.exe ../streams/file1.png ../streams/file1.mp3 + ./theora-test.mp4 (package liquidsoap) (source_tree ../../src/libs) (:test_liq ../test.liq) From e584af378b5ecad31046cb118b26946b8bd6f1c6 Mon Sep 17 00:00:00 2001 From: fetsorn Date: Wed, 4 Sep 2024 19:44:21 +0500 Subject: [PATCH 009/151] fix typo habor -> harbor (#4121) --- CHANGES.md | 2 +- src/libs/extra/interactive.liq | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index d9c7cf460a..7bf23f1af2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -893,7 +893,7 @@ New: harbor (#1495). - Added `interactive.persistent` (as well as `interactive.save` and `interactive.load`) to make interactive variables persistent (#1495). -- Added `server.habor` (#1502). +- Added `server.harbor` (#1502). - Added `metronome`. - Added `playlist.files`. - Added `getter.is_constant`. diff --git a/src/libs/extra/interactive.liq b/src/libs/extra/interactive.liq index 8884e300d8..203b179ed2 100644 --- a/src/libs/extra/interactive.liq +++ b/src/libs/extra/interactive.liq @@ -442,7 +442,7 @@ def interactive.persistent(fname) = interactive.persistency := {interactive.save(fname)} end -# Expose interactive variables through habor http server. Once this is called, +# Expose interactive variables through harbor http server. Once this is called, # with default parameters, you can browse to # change the value of interactive variables using sliders. # @category Interaction From a5d8cb92b77885d03f9a910e014981081d1813b4 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 12 Sep 2024 01:36:54 -0500 Subject: [PATCH 010/151] Fix test.fail calls. (#4129) --- tests/test.liq | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/test.liq b/tests/test.liq index b54f961c44..94caf477c1 100644 --- a/tests/test.liq +++ b/tests/test.liq @@ -108,9 +108,9 @@ def test.equal(v, v') = }" print(msg) - error.raise(error.failure, msg) + thread.run({test.fail()}) - test.fail() + error.raise(error.failure, msg) end end @@ -128,9 +128,9 @@ def test.not.equal(first, second) = print(msg) - error.raise(error.failure, msg) + thread.run({test.fail()}) - test.fail() + error.raise(error.failure, msg) end end @@ -159,6 +159,8 @@ def test.almost_equal(~digits=7, first, second) = if not is_almost_equal then + thread.run({test.fail()}) + error.raise( error.failure, "#{string.quote(string(first))} != #{ @@ -166,8 +168,6 @@ def test.almost_equal(~digits=7, first, second) = } up to #{digits} digits, diff = #{is_almost_equal.diff}." ) - - test.fail() end end @@ -180,6 +180,8 @@ def test.not_almost_equal(~digits=7, first, second) = if is_almost_equal then + thread.run({test.fail()}) + error.raise( error.failure, "#{string.quote(string(first))} == #{ @@ -187,8 +189,6 @@ def test.not_almost_equal(~digits=7, first, second) = } up to #{digits} digits, diff = #{is_almost_equal.diff}." ) - - test.fail() end end From ebe74c77a2c7fd2e04abddb8f493a05701c17414 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 12 Sep 2024 19:39:41 -0500 Subject: [PATCH 011/151] Fix #4124 (#4132) --- src/core/operators/iir_filter.ml | 3 ++- tests/regression/GH4124.liq | 3 +++ tests/regression/dune.inc | 16 ++++++++++++++++ 3 files changed, 21 insertions(+), 1 deletion(-) create mode 100644 tests/regression/GH4124.liq diff --git a/src/core/operators/iir_filter.ml b/src/core/operators/iir_filter.ml index 4868d4b0ea..cb5abb2b99 100644 --- a/src/core/operators/iir_filter.ml +++ b/src/core/operators/iir_filter.ml @@ -62,8 +62,9 @@ class iir (source : source) filter_family filter_type order freq1 freq2 qfactor (* I/O shift registries *) val mutable xv = [||] val mutable yv = [||] + initializer self#on_wake_up (fun () -> self#initialize) - initializer + method private initialize = self#log#info "Initializing..."; self#log#info "Alpha 1: %.013f (warped: %.013f)" raw_alpha1 warped_alpha1; self#log#info "Alpha 2: %.013f (warped: %.013f)" raw_alpha2 warped_alpha2; diff --git a/tests/regression/GH4124.liq b/tests/regression/GH4124.liq new file mode 100644 index 0000000000..67a90028c6 --- /dev/null +++ b/tests/regression/GH4124.liq @@ -0,0 +1,3 @@ +s = sine() +s = filter.iir.butterworth.high(s, frequency=250., order=2) +output.dummy(on_start=test.pass, s) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index 61353c7d72..2ba814c12a 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -687,6 +687,22 @@ (:run_test ../run_test.exe)) (action (run %{run_test} GH4116.liq liquidsoap %{test_liq} GH4116.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + GH4124.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} GH4124.liq liquidsoap %{test_liq} GH4124.liq))) + (rule (alias citest) (package liquidsoap) From 310b5fc2e266999d70f67c5d56282fbdd3d0a51d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 13 Sep 2024 12:56:38 -0500 Subject: [PATCH 012/151] Dynamic source tracks. (#4128) --- src/core/dune | 1 + src/core/hooks_implementations.ml | 3 + src/core/lang_source.ml | 11 --- src/core/operators/muxer.ml | 127 +++++++++++++++++++++--------- src/core/source_tracks.ml | 68 ++++++++++++++++ src/core/source_tracks.mli | 28 +++++++ src/lang/evaluation.ml | 37 +++++++-- src/lang/value.ml | 28 +++++-- 8 files changed, 242 insertions(+), 61 deletions(-) create mode 100644 src/core/source_tracks.ml create mode 100644 src/core/source_tracks.mli diff --git a/src/core/dune b/src/core/dune index 96dfd4c7d9..74fb5b2b1d 100644 --- a/src/core/dune +++ b/src/core/dune @@ -233,6 +233,7 @@ theora_format time_warp track + source_tracks track_map tutils type diff --git a/src/core/hooks_implementations.ml b/src/core/hooks_implementations.ml index 78326ea893..3b0e068a57 100644 --- a/src/core/hooks_implementations.ml +++ b/src/core/hooks_implementations.ml @@ -18,6 +18,9 @@ let eval_check ~env:_ ~tm v = let ty = Type.fresh (deep_demeth tm.Term.t) in Typing.(Lang_source.source_t ~methods:false s#frame_type <: ty); s#content_type_computation_allowed)) + else if Source_tracks.is_value v then ( + let s = Source_tracks.source v in + Typing.(s#frame_type <: tm.Term.t)) else if Track.is_value v then ( let field, source = Lang_source.to_track v in if not source#has_content_type then ( diff --git a/src/core/lang_source.ml b/src/core/lang_source.ml index 2b4139edd5..eb6c3c630a 100644 --- a/src/core/lang_source.ml +++ b/src/core/lang_source.ml @@ -361,17 +361,6 @@ let source_tracks_t frame_t = ([], Format_type.track_marks) (Type.meth "metadata" ([], Format_type.metadata) frame_t) -let source_tracks s = - meth unit - (( Frame.Fields.string_of_field Frame.Fields.metadata, - Track.to_value (Frame.Fields.metadata, s) ) - :: ( Frame.Fields.string_of_field Frame.Fields.track_marks, - Track.to_value (Frame.Fields.track_marks, s) ) - :: List.map - (fun (field, _) -> - (Frame.Fields.string_of_field field, Track.to_value (field, s))) - (Frame.Fields.bindings s#content_type)) - let source_methods ~base s = meth base (List.map (fun (name, _, _, fn) -> (name, fn s)) source_methods) diff --git a/src/core/operators/muxer.ml b/src/core/operators/muxer.ml index a4fd0b332a..04825f681a 100644 --- a/src/core/operators/muxer.ml +++ b/src/core/operators/muxer.ml @@ -20,30 +20,22 @@ *****************************************************************************) -type field = { - target_field : Frame.field; - source_field : Frame.field; - processor : Content.data -> Content.data; -} - +type field = { target_field : Frame.field; source_field : Frame.field } type track = { mutable fields : field list; source : Source.source } -class muxer tracks = +class muxer ~pos ~base tracks = let sources = List.fold_left (fun sources { source } -> if List.memq source sources then sources else source :: sources) - [] tracks + (match base with Some s -> [Source_tracks.source s] | None -> []) + tracks in let fallible = List.exists (fun s -> s#fallible) sources in let self_sync = Clock_base.self_sync sources in object (self) (* Pass duplicated list to operator to make sure caching is properly enabled. *) - inherit - Source.operator - ~name:"source" - (List.map (fun { source } -> source) tracks) - + inherit Source.operator ~name:"source" sources method self_sync = self_sync ~source:self () method fallible = fallible method abort_track = List.iter (fun s -> s#abort_track) sources @@ -76,6 +68,66 @@ class muxer tracks = (-1) (List.filter (fun (s : Source.source) -> s#is_ready) sources) + val mutable muxed_tracks = None + + method private tracks = + match muxed_tracks with + | Some s -> s + | None -> + let base = + match base with + | Some source_tracks -> + let fields = + List.map + (fun source_field -> + { source_field; target_field = source_field }) + (Source_tracks.fields source_tracks) + in + [{ source = Source_tracks.source source_tracks; fields }] + | None -> [] + in + let tracks = + match + ( base, + List.partition + (fun { source = s } -> + List.exists (fun { source = s' } -> s == s') base) + tracks ) + with + | _, ([], _) -> base @ tracks + | [{ fields = f }], ([({ fields = f' } as p)], tracks) -> + { + p with + fields = + f' + @ List.filter + (fun { target_field = t } -> + List.exists + (fun { target_field = t' } -> t = t') + f') + f; + } + :: tracks + | _ -> assert false + in + if + List.for_all + (fun { fields } -> + List.for_all + (fun { target_field } -> + target_field = Frame.Fields.metadata + || target_field = Frame.Fields.track_marks) + fields) + tracks + then + Runtime_error.raise ~pos + ~message: + "source muxer needs at least one track with content that is \ + not metadata or track_marks!" + "invalid"; + muxed_tracks <- Some tracks; + tracks + method generate_frame = let length = Lazy.force Frame.size in let pos, frame = @@ -84,49 +136,39 @@ class muxer tracks = let buf = source#get_frame in ( min pos (Frame.position buf), List.fold_left - (fun frame { source_field; target_field; processor } -> - let c = processor (Frame.get buf source_field) in + (fun frame { source_field; target_field } -> + let c = Frame.get buf source_field in Frame.set frame target_field c) frame fields )) (length, Frame.create ~length Frame.Fields.empty) - tracks + self#tracks in Frame.slice frame pos end let muxer_operator p = - let tracks = List.assoc "" p in - let processor c = c in + let base, tracks = + match List.assoc "" p with + | Liquidsoap_lang.Value.Custom { methods } as v + when Source_tracks.is_value v -> + (Some v, methods) + | v -> (None, Liquidsoap_lang.Value.methods v) + in let tracks = List.fold_left (fun tracks (label, t) -> let source_field, s = Lang.to_track t in let target_field = Frame.Fields.register label in - let field = { source_field; target_field; processor } in + let field = { source_field; target_field } in match List.find_opt (fun { source } -> source == s) tracks with | Some track -> track.fields <- field :: track.fields; tracks | None -> { source = s; fields = [field] } :: tracks) [] - (fst (Lang.split_meths tracks)) + (Liquidsoap_lang.Methods.bindings tracks) in - if - List.for_all - (fun { fields } -> - List.for_all - (fun { target_field } -> - target_field = Frame.Fields.metadata - || target_field = Frame.Fields.track_marks) - fields) - tracks - then - Runtime_error.raise ~pos:(Lang.pos p) - ~message: - "source muxer needs at least one track with content that is not \ - metadata or track_marks!" - "invalid"; - let s = new muxer tracks in + let s = new muxer ~pos:(try Lang.pos p with _ -> []) ~base tracks in let target_fields = List.fold_left (fun target_fields { source; fields } -> @@ -151,7 +193,13 @@ let muxer_operator p = target_fields) Frame.Fields.empty tracks in - Typing.(s#frame_type <: Lang.frame_t (Lang.univ_t ()) target_fields); + Typing.( + s#frame_type + <: Lang.frame_t + (match base with + | Some s -> (Source_tracks.source s)#frame_type + | None -> Lang.univ_t ()) + target_fields); s let source = @@ -199,6 +247,7 @@ let _ = Type.filter_meths return_t (fun { Type.meth } -> meth <> "metadata" && meth <> "track_marks") in - let s = Lang.to_source (List.assoc "" env) in + let source_val = List.assoc "" env in + let s = Lang.to_source source_val in Typing.(s#frame_type <: return_t); - Lang_source.source_tracks s) + Source_tracks.to_value s) diff --git a/src/core/source_tracks.ml b/src/core/source_tracks.ml new file mode 100644 index 0000000000..881426d484 --- /dev/null +++ b/src/core/source_tracks.ml @@ -0,0 +1,68 @@ +(***************************************************************************** + + Liquidsoap, a programmable stream generator. + Copyright 2003-2024 Savonet team + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details, fully stated in the COPYING + file at the root of the liquidsoap distribution. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + *****************************************************************************) + +include Liquidsoap_lang.Lang_core.MkCustom (struct + type content = Source.source + + let name = "source.tracks" + let to_string s = Printf.sprintf "source.tracks(source=%s)" s#id + + let to_json ~pos _ = + Runtime_error.raise ~pos + ~message:"Source tracks cannot be represented as json" "json" + + let compare s1 s2 = Stdlib.compare s1#id s2#id +end) + +let to_value ?pos s = + match to_value ?pos s with + | Liquidsoap_lang.Value.Custom p -> + Liquidsoap_lang.Value.Custom + { + p with + dynamic_methods = + Some + { + hidden_methods = []; + methods = + (fun v -> + Some (Track.to_value (Frame.Fields.register v, s))); + }; + } + | _ -> assert false + +let source = of_value + +let fields = function + | Liquidsoap_lang.Value.Custom { dynamic_methods = Some { hidden_methods } } + as v + when is_value v -> + let source = of_value v in + let fields = + Frame.Fields.metadata :: Frame.Fields.track_marks + :: List.map fst (Frame.Fields.bindings source#content_type) + in + List.filter + (fun field -> + not (List.mem (Frame.Fields.string_of_field field) hidden_methods)) + fields + | _ -> assert false diff --git a/src/core/source_tracks.mli b/src/core/source_tracks.mli new file mode 100644 index 0000000000..4234c03e36 --- /dev/null +++ b/src/core/source_tracks.mli @@ -0,0 +1,28 @@ +(***************************************************************************** + + Liquidsoap, a programmable stream generator. + Copyright 2003-2024 Savonet team + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details, fully stated in the COPYING + file at the root of the liquidsoap distribution. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + *****************************************************************************) + +type content = Source.source + +val to_value : ?pos:Pos.t -> content -> Value.t +val source : Value.t -> content +val is_value : Value.t -> bool +val fields : Value.t -> Frame.Fields.field list diff --git a/src/lang/evaluation.ml b/src/lang/evaluation.ml index 2efc2b1afd..82ec64acef 100644 --- a/src/lang/evaluation.ml +++ b/src/lang/evaluation.ml @@ -180,16 +180,41 @@ and eval_base_term ~eval_check (env : Env.t) tm = | `List l -> mk (`List (List.map (eval ~eval_check env) l)) | `Tuple l -> mk (`Tuple (List.map (fun a -> eval ~eval_check env a) l)) | `Null -> mk `Null - | `Hide (tm, methods) -> + | `Hide (tm, methods) -> ( let v = eval ~eval_check env tm in - Value.map_methods v - (Methods.filter (fun n _ -> not (List.mem n methods))) + let v = + Value.map_methods v + (Methods.filter (fun n _ -> not (List.mem n methods))) + in + match v with + | Value.Custom ({ dynamic_methods = Some d } as p) -> + Value.Custom + { + p with + dynamic_methods = + Some + { + d with + hidden_methods = + List.sort_uniq Stdlib.compare + (methods @ d.hidden_methods); + }; + } + | v -> v) | `Cast { cast = e } -> Value.set_pos (eval ~eval_check env e) tm.t.Type.pos | `Invoke { invoked = t; invoke_default; meth } -> ( let v = eval ~eval_check env t in - match - (Value.Methods.find_opt meth (Value.methods v), invoke_default) - with + let invoked_value = + match (Value.Methods.find_opt meth (Value.methods v), v) with + | Some v, _ -> Some v + | ( None, + Value.Custom + { dynamic_methods = Some { hidden_methods; methods } } ) + when not (List.mem meth hidden_methods) -> + methods meth + | _ -> None + in + match (invoked_value, invoke_default) with (* If method returns `null` and a default is provided, pick default. *) | Some (Value.Null { methods }), Some default when Methods.is_empty methods -> diff --git a/src/lang/value.ml b/src/lang/value.ml index a40494a967..714168ab74 100644 --- a/src/lang/value.ml +++ b/src/lang/value.ml @@ -30,6 +30,11 @@ module Methods = Runtime_term.Methods when the builtin env change. We mostly keep name and methods. *) type env = (string * t) list +and dynamic_methods = { + hidden_methods : string list; + methods : string -> t option; [@hash.ignore] +} + and t = | Int of { pos : Pos.Option.t; [@hash.ignore] @@ -57,6 +62,7 @@ and t = pos : Pos.Option.t; [@hash.ignore] value : Custom.t; [@hash.ignore] methods : t Methods.t; + dynamic_methods : dynamic_methods option; mutable flags : Flags.flags; [@hash.ignore] } | List of { @@ -200,7 +206,8 @@ let make ?pos ?(methods = Methods.empty) ?(flags = Flags.empty) : in_value -> t | `Float f -> Float { pos; methods; value = f } | `String s -> String { pos; methods; value = s } | `Bool b -> Bool { pos; methods; value = b } - | `Custom c -> Custom { pos; methods; flags; value = c } + | `Custom c -> + Custom { pos; methods; flags; dynamic_methods = None; value = c } | `Null -> Null { pos; methods } | `Tuple l -> Tuple { pos; methods; flags; value = l } | `List l -> List { pos; methods; flags; value = l } @@ -252,14 +259,25 @@ let rec to_string v = (** Find a method in a value. *) let invoke x l = - try Methods.find l (methods x) - with Not_found -> - failwith ("Could not find method " ^ l ^ " of " ^ to_string x) + try + match (Methods.find_opt l (methods x), x) with + | Some v, _ -> v + | None, Custom { dynamic_methods = Some { hidden_methods; methods } } + when not (List.mem l hidden_methods) -> + Option.get (methods l) + | _ -> raise Not_found + with _ -> failwith ("Could not find method " ^ l ^ " of " ^ to_string x) (** Perform a sequence of invokes: invokes x [l1;l2;l3;...] is x.l1.l2.l3... *) let rec invokes x = function l :: ll -> invokes (invoke x l) ll | [] -> x -let demeth e = map_methods e (fun _ -> Methods.empty) +let demeth e = + map_methods + (match e with + | Custom p -> + Custom { p with methods = Methods.empty; dynamic_methods = None } + | _ -> e) + (fun _ -> Methods.empty) let remeth t u = let t_methods = methods t in From 2c9ce7f40e18aa91239c7e1df0aa70befc0552b1 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 14 Sep 2024 14:29:10 -0500 Subject: [PATCH 013/151] Prioritize, use file decoders file extensions when computing request duration. (#4134) --- src/core/decoder/external_decoder.ml | 18 +++++++--- src/core/decoder/ffmpeg_decoder.ml | 18 ++++++---- src/core/decoder/liq_flac_decoder.ml | 8 +++-- src/core/decoder/mad_decoder.ml | 9 +++-- src/core/decoder/ogg_flac_duration.ml | 10 ++++-- src/core/decoder/vorbisduration.ml | 10 ++++-- src/core/decoder/wav_aiff_decoder.ml | 9 +++-- src/core/request.ml | 49 ++++++++++++++++++++++++--- src/core/request.mli | 11 +++++- 9 files changed, 116 insertions(+), 26 deletions(-) diff --git a/src/core/decoder/external_decoder.ml b/src/core/decoder/external_decoder.ml index 77bf4b6e81..2a60670808 100644 --- a/src/core/decoder/external_decoder.ml +++ b/src/core/decoder/external_decoder.ml @@ -120,13 +120,18 @@ let register_stdin ~name ~doc ~priority ~mimes ~file_extensions ~test process = stream_decoder = Some (fun ~ctype:_ _ -> create_stream process); }; - let duration ~metadata:_ filename = + let dresolver ~metadata:_ filename = let process = Printf.sprintf "cat %s | %s" (Filename.quote filename) process in duration process in - Plug.register Request.dresolvers name ~doc duration + Plug.register Request.dresolvers name ~doc + { + dpriority = (fun () -> priority); + file_extensions = (fun () -> Option.value ~default:[] file_extensions); + dresolver; + } (** Now an external decoder that directly operates * on the file. The remaining time in this case @@ -196,5 +201,10 @@ let register_oblivious ~name ~doc ~priority ~mimes ~file_extensions ~test stream_decoder = None; }; - let duration ~metadata:_ filename = duration (process filename) in - Plug.register Request.dresolvers name ~doc duration + let dresolver ~metadata:_ filename = duration (process filename) in + Plug.register Request.dresolvers name ~doc + { + dpriority = (fun () -> priority); + file_extensions = (fun () -> Option.value ~default:[] file_extensions); + dresolver; + } diff --git a/src/core/decoder/ffmpeg_decoder.ml b/src/core/decoder/ffmpeg_decoder.ml index bcdf167a34..054ac0179f 100644 --- a/src/core/decoder/ffmpeg_decoder.ml +++ b/src/core/decoder/ffmpeg_decoder.ml @@ -546,7 +546,7 @@ let parse_file_decoder_args metadata = | Some args -> parse_input_args args | None -> ([], None) -let duration ~metadata file = +let dresolver ~metadata file = let args, format = parse_file_decoder_args metadata in let opts = Hashtbl.create 10 in List.iter (fun (k, v) -> Hashtbl.replace opts k v) args; @@ -558,10 +558,16 @@ let duration ~metadata file = Option.map (fun d -> Int64.to_float d /. 1000.) duration) let () = - Plug.register Request.dresolvers "ffmepg" ~doc:"" (fun ~metadata fname -> - match duration ~metadata fname with - | None -> raise Not_found - | Some d -> d) + Plug.register Request.dresolvers "ffmepg" ~doc:"" + { + dpriority = (fun () -> priority#get); + file_extensions = (fun () -> file_extensions#get); + dresolver = + (fun ~metadata fname -> + match dresolver ~metadata fname with + | None -> raise Not_found + | Some d -> d); + } let tags_substitutions = [("track", "tracknumber")] @@ -1087,7 +1093,7 @@ let mk_streams ~ctype ~decode_first_metadata container = let create_decoder ~ctype ~metadata fname = let args, format = parse_file_decoder_args metadata in - let file_duration = duration ~metadata fname in + let file_duration = dresolver ~metadata fname in let remaining = Atomic.make file_duration in let set_remaining ~pts ~duration stream = let pts = diff --git a/src/core/decoder/liq_flac_decoder.ml b/src/core/decoder/liq_flac_decoder.ml index 826616cae7..5a7ff869a6 100644 --- a/src/core/decoder/liq_flac_decoder.ml +++ b/src/core/decoder/liq_flac_decoder.ml @@ -184,7 +184,7 @@ let check filename = true with _ -> false -let duration ~metadata:_ file = +let dresolver ~metadata:_ file = if not (check file) then raise Not_found; let fd = Decoder.openfile file in Fun.protect @@ -199,4 +199,8 @@ let duration ~metadata:_ file = let () = Plug.register Request.dresolvers "flac" ~doc:"Compute duration of flac files." - duration + { + dpriority = (fun () -> priority#get); + file_extensions = (fun () -> file_extensions#get); + dresolver; + } diff --git a/src/core/decoder/mad_decoder.ml b/src/core/decoder/mad_decoder.ml index cb341c0e99..1479b6999f 100644 --- a/src/core/decoder/mad_decoder.ml +++ b/src/core/decoder/mad_decoder.ml @@ -189,11 +189,16 @@ let check filename = true with _ -> false -let duration ~metadata:_ file = +let dresolver ~metadata:_ file = if not (check file) then raise Not_found; let ans = Mad.duration file in match ans with 0. -> raise Not_found | _ -> ans let () = Plug.register Request.dresolvers "mad" - ~doc:"Compute duration of mp3 files using MAD library." duration + ~doc:"Compute duration of mp3 files using MAD library." + { + dpriority = (fun () -> priority#get); + file_extensions = (fun () -> file_extensions#get); + dresolver; + } diff --git a/src/core/decoder/ogg_flac_duration.ml b/src/core/decoder/ogg_flac_duration.ml index f291cc4999..339c3d642e 100644 --- a/src/core/decoder/ogg_flac_duration.ml +++ b/src/core/decoder/ogg_flac_duration.ml @@ -22,7 +22,7 @@ (** Read duration of ogg/flac files. *) -let duration ~metadata:_ file = +let dresolver ~metadata:_ file = let sync, fd = Ogg.Sync.create_from_file file in Fun.protect ~finally:(fun () -> Unix.close fd) @@ -63,4 +63,10 @@ let duration ~metadata:_ file = if samples <= 0. then raise Not_found; samples /. float info.Flac.Decoder.sample_rate) -let () = Plug.register Request.dresolvers "ogg/flac" ~doc:"" duration +let () = + Plug.register Request.dresolvers "ogg/flac" ~doc:"" + { + dpriority = (fun () -> Liq_ogg_decoder.priority#get); + file_extensions = (fun () -> Liq_ogg_decoder.file_extensions#get); + dresolver; + } diff --git a/src/core/decoder/vorbisduration.ml b/src/core/decoder/vorbisduration.ml index 0b5dee4952..679f83ac1b 100644 --- a/src/core/decoder/vorbisduration.ml +++ b/src/core/decoder/vorbisduration.ml @@ -22,10 +22,16 @@ (** Read duration of ogg/vorbis files. *) -let duration ~metadata:_ file = +let dresolver ~metadata:_ file = let dec, fd = Vorbis.File.Decoder.openfile file in Fun.protect ~finally:(fun () -> Unix.close fd) (fun _ -> Vorbis.File.Decoder.duration dec (-1)) -let () = Plug.register Request.dresolvers "vorbis" ~doc:"" duration +let () = + Plug.register Request.dresolvers "vorbis" ~doc:"" + { + dpriority = (fun () -> Liq_ogg_decoder.priority#get); + file_extensions = (fun () -> Liq_ogg_decoder.file_extensions#get); + dresolver; + } diff --git a/src/core/decoder/wav_aiff_decoder.ml b/src/core/decoder/wav_aiff_decoder.ml index 868bea6da9..ed0f0b0fcc 100644 --- a/src/core/decoder/wav_aiff_decoder.ml +++ b/src/core/decoder/wav_aiff_decoder.ml @@ -219,14 +219,19 @@ let () = } let () = - let duration ~metadata:_ file = + let dresolver ~metadata:_ file = let w = Wav_aiff.fopen file in let ret = Wav_aiff.duration w in Wav_aiff.close w; ret in Plug.register Request.dresolvers "wav/aiff" - ~doc:"Native computation of wav and aiff files duration." duration + ~doc:"Native computation of wav and aiff files duration." + { + dpriority = (fun () -> aiff_priorities#get); + file_extensions = (fun () -> aiff_file_extensions#get); + dresolver; + } let basic_mime_types = Dtools.Conf.list diff --git a/src/core/request.ml b/src/core/request.ml index 42cdd400d7..74773d990c 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -121,20 +121,59 @@ let status { status } = Atomic.get status let indicator ?(metadata = Frame.Metadata.empty) ?temporary s = { uri = home_unrelate s; temporary = temporary = Some true; metadata } -(** Length *) +type dresolver = { + dpriority : unit -> int; + file_extensions : unit -> string list; + dresolver : metadata:Frame.metadata -> string -> float; +} + let dresolvers_doc = "Methods to extract duration from a file." -let dresolvers = Plug.create ~doc:dresolvers_doc "audio file formats (duration)" +let conf_dresolvers = + Dtools.Conf.list ~p:(conf#plug "dresolvers") ~d:[] + "Methods to extract file duration." + +let f c v = + match c#get_d with + | None -> c#set_d (Some [v]) + | Some d -> c#set_d (Some (d @ [v])) + +let dresolvers = + Plug.create ~doc:dresolvers_doc + ~register_hook:(fun name _ -> f conf_dresolvers name) + "audio file formats (duration)" + +let get_dresolvers ~file () = + let extension = try Utils.get_ext file with _ -> "" in + let f cur name = + match Plug.get dresolvers name with + | Some ({ file_extensions } as p) + when List.mem extension (file_extensions ()) -> + (name, p) :: cur + | Some _ -> cur + | None -> + log#severe "Cannot find duration resolver %s" name; + cur + in + let resolvers = List.fold_left f [] conf_dresolvers#get in + List.sort + (fun (_, a) (_, b) -> compare (b.dpriority ()) (a.dpriority ())) + resolvers let compute_duration ~metadata file = try - Plug.iter dresolvers (fun _ resolver -> + List.iter + (fun (name, { dpriority; dresolver }) -> try - let ans = resolver ~metadata file in + log#info "Trying duration resolver %s (priority: %d) for file %s.." + name (dpriority ()) + (Lang_string.quote_string file); + let ans = dresolver ~metadata file in raise (Duration ans) with | Duration e -> raise (Duration e) - | _ -> ()); + | _ -> ()) + (get_dresolvers ~file ()); raise Not_found with Duration d -> d diff --git a/src/core/request.mli b/src/core/request.mli index ef3d9aa55d..a17b637942 100644 --- a/src/core/request.mli +++ b/src/core/request.mli @@ -113,6 +113,9 @@ type resolve_flag = [ `Resolved | `Failed | `Timeout ] (** Metadata resolvers priorities. *) val conf_metadata_decoder_priorities : Dtools.Conf.ut +(** Read the request's metadata. *) +val read_metadata : t -> unit + (** [resolve request timeout] tries to resolve the request within [timeout] seconds. *) val resolve : t -> float -> resolve_flag @@ -165,8 +168,14 @@ val done_playing : source:Source.source -> t -> unit (** {1 Plugs} *) +type dresolver = { + dpriority : unit -> int; + file_extensions : unit -> string list; + dresolver : metadata:Frame.metadata -> string -> float; +} + (** Functions for computing duration. *) -val dresolvers : (metadata:Frame.metadata -> string -> float) Plug.t +val dresolvers : dresolver Plug.t (** Type for a metadata resolver. Resolvers are executed in priority order and the first returned metadata take precedence over any other From 24f37336526e5ce84601c267166746961e521c50 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 15 Sep 2024 11:54:32 -0500 Subject: [PATCH 014/151] Expand HLS segment name metadata (#4135) --- CHANGES.md | 1 + doc/content/liq/output.file.hls.liq | 61 +++++----- doc/content/migrating.md | 13 +++ src/core/outputs/hls_output.ml | 156 +++++++++++++++---------- src/libs/hls.liq | 8 +- tests/media/ffmpeg_distributed_hls.liq | 3 +- tests/media/ffmpeg_drop_tracks.liq | 3 +- tests/media/ffmpeg_raw_hls.liq | 5 +- tests/streams/hls_id3v2.liq | 5 +- 9 files changed, 149 insertions(+), 106 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 7bf23f1af2..5b345bc6a4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -38,6 +38,7 @@ New: one stream is encoded. - Allow trailing commas in record definition (#3300). - Add `metadata.getter.source.float` (#3356). +- BREAKING: Added `duration` and `ticks` to metadata available when computing HLS segment names (#4135) - Added optional `main_playlist_writer` to `output.file.hls` and derivated operator (#3484) - Added `is_nan`, `is_infinite`, `ceil`, `floor`, `sign` and `round` (#3407) diff --git a/doc/content/liq/output.file.hls.liq b/doc/content/liq/output.file.hls.liq index e09e5d4cf0..59f239a282 100644 --- a/doc/content/liq/output.file.hls.liq +++ b/doc/content/liq/output.file.hls.liq @@ -1,44 +1,37 @@ s = mksafe(playlist("playlist")) -aac_lofi = %ffmpeg(format="mpegts", - %audio( - codec="aac", - channels=2, - ar=44100 - )) +aac_lofi = + %ffmpeg(format = "mpegts", %audio(codec = "aac", channels = 2, ar = 44100)) -aac_midfi = %ffmpeg(format="mpegts", - %audio( - codec="aac", - channels=2, - ar=44100, - b="96k" - )) +aac_midfi = + %ffmpeg( + format = "mpegts", + %audio(codec = "aac", channels = 2, ar = 44100, b = "96k") + ) -aac_hifi = %ffmpeg(format="mpegts", - %audio( - codec="aac", - channels=2, - ar=44100, - b="192k" - )) +aac_hifi = + %ffmpeg( + format = "mpegts", + %audio(codec = "aac", channels = 2, ar = 44100, b = "192k") + ) -streams = [("aac_lofi",aac_lofi), - ("aac_midfi", aac_midfi), - ("aac_hifi", aac_hifi)] +streams = + [("aac_lofi", aac_lofi), ("aac_midfi", aac_midfi), ("aac_hifi", aac_hifi)] -def segment_name(~position,~extname,stream_name) = +def segment_name(metadata) = timestamp = int_of_float(time()) - duration = 2 + let {stream_name, duration, position, extname} = metadata "#{stream_name}_#{duration}_#{timestamp}_#{position}.#{extname}" end -output.file.hls(playlist="live.m3u8", - segment_duration=2.0, - segments=5, - segments_overhead=5, - segment_name=segment_name, - persist_at="/tmp/path/to/state.config", - "/tmp/path/to/hls/directory", - streams, - s) +output.file.hls( + playlist="live.m3u8", + segment_duration=2.0, + segments=5, + segments_overhead=5, + segment_name=segment_name, + persist_at="/tmp/path/to/state.config", + "/tmp/path/to/hls/directory", + streams, + s +) diff --git a/doc/content/migrating.md b/doc/content/migrating.md index e884f591ec..5ec412fbb0 100644 --- a/doc/content/migrating.md +++ b/doc/content/migrating.md @@ -115,6 +115,19 @@ Known incompatibilities include: - `(?Ppattern)` for named captures is not supported. `(?pattern)` should be used instead. +### `segment_name` in HLS outputs + +To make segment name more flexible, `duration` (segment duration in seconds) and `ticks` (segment exact duration in liquidsoap's main ticks) have been added +to the data available when calling `segment_name`. + +To prevent any further breakage of this function, its arguments have been changed to a single record containing all the available attributes: + +```liquidsoap +def segment_name(metadata) = + "#{metadata.stream_name}_#{metadata.position}.#{metadata.extname}" +end +``` + ### `on_air` metadata Request `on_air` and `on_air_timestamp` metadata are deprecated. These values were never reliable. They are set at the request level when `request.dynamic` diff --git a/src/core/outputs/hls_output.ml b/src/core/outputs/hls_output.ml index 2679e206f8..f3569baf1f 100644 --- a/src/core/outputs/hls_output.ml +++ b/src/core/outputs/hls_output.ml @@ -29,7 +29,7 @@ let log = Log.make ["hls"; "output"] let default_name = Lang.eval ~cache:false ~typecheck:false ~stdlib:`Disabled - {|fun (~position, ~extname, base) -> "#{base}_#{position}.#{extname}"|} + {|fun (metadata) -> "#{metadata.stream_name}_#{metadata.position}.#{metadata.extname}"|} let hls_proto frame_t = let main_playlist_writer_t = @@ -58,9 +58,16 @@ let hls_proto frame_t = let segment_name_t = Lang.fun_t [ - (false, "position", Lang.int_t); - (false, "extname", Lang.string_t); - (false, "", Lang.string_t); + ( false, + "", + Lang.record_t + [ + ("position", Lang.int_t); + ("extname", Lang.string_t); + ("duration", Lang.float_t); + ("ticks", Lang.int_t); + ("stream_name", Lang.string_t); + ] ); ] Lang.string_t in @@ -117,8 +124,9 @@ let hls_proto frame_t = segment_name_t, Some default_name, Some - "Segment name. Default: `fun (~position,~extname,stream_name) -> \ - \"#{stream_name}_#{position}.#{extname}\"`" ); + "Segment name. Default: `fun (metadata) -> \ + \"#{metadata.stream_name}_#{metadata.position}.#{metadata.extname}\"`" + ); ( "segments_overhead", Lang.nullable_t Lang.int_t, Some (Lang.int 5), @@ -180,6 +188,7 @@ type atomic_out_channel = ; output_substring : string -> int -> int -> unit ; position : int ; truncate : int -> unit + ; saved_filename : string option ; read : int -> int -> string ; close : unit > @@ -187,10 +196,11 @@ type segment = { id : int; discontinuous : bool; current_discontinuity : int; - filename : string; segment_extra_tags : string list; mutable init_filename : string option; + mutable filename : string option; mutable out_channel : atomic_out_channel option; + (* Segment length in main ticks. *) mutable len : int; mutable last_segmentable_position : (int * int) option; } @@ -222,8 +232,8 @@ let json_of_segment id; discontinuous; current_discontinuity; - filename; init_filename; + filename; segment_extra_tags; len; last_segmentable_position; @@ -233,9 +243,9 @@ let json_of_segment ("id", `Int id); ("discontinuous", `Bool discontinuous); ("current_discontinuity", `Int current_discontinuity); - ("filename", `String filename); ] @ json_optional "init_filename" (fun s -> `String s) init_filename + @ json_optional "filename" (fun s -> `String s) filename @ [ ("extra_tags", `Tuple (List.map (fun s -> `String s) segment_extra_tags)); ("len", `Int len); @@ -249,7 +259,6 @@ let segment_of_json = function let id = parse_json_int "id" l in let discontinuous = parse_json_bool "discontinuous" l in let current_discontinuity = parse_json_int "current_discontinuity" l in - let filename = parse_json_string "filename" l in let segment_extra_tags = parse_json "extra_tags" (function @@ -266,6 +275,11 @@ let segment_of_json = function (function `String s -> s | _ -> raise Invalid_state) l in + let filename = + parse_json_optional "filename" + (function `String s -> s | _ -> raise Invalid_state) + l + in let last_segmentable_position = parse_json_optional "last_segmentable_position" (function @@ -277,10 +291,10 @@ let segment_of_json = function id; discontinuous; current_discontinuity; - filename; init_filename; len; segment_extra_tags; + filename; out_channel = None; last_segmentable_position; } @@ -394,16 +408,20 @@ class hls_output p = (Lang.to_option (List.assoc "main_playlist_writer" p)) in let directory_val = Lang.assoc "" 1 p in - let directory = Lang_string.home_unrelate (Lang.to_string directory_val) in + let hls_directory = + Lang_string.home_unrelate (Lang.to_string directory_val) + in let perms = Lang.to_int (List.assoc "perm" p) in let dir_perm = Lang.to_int (List.assoc "dir_perm" p) in let temp_dir = Lang.to_valued_option Lang.to_string (List.assoc "temp_dir" p) in let () = - if (not (Sys.file_exists directory)) || not (Sys.is_directory directory) + if + (not (Sys.file_exists hls_directory)) + || not (Sys.is_directory hls_directory) then ( - try Utils.mkdir ~perm:dir_perm directory + try Utils.mkdir ~perm:dir_perm hls_directory with _ -> raise (Error.Invalid_value @@ -415,7 +433,7 @@ class hls_output p = let filename = Lang.to_string filename in let filename = if Filename.is_relative filename then - Filename.concat directory filename + Filename.concat hls_directory filename else filename in let dir = Filename.dirname filename in @@ -440,15 +458,20 @@ class hls_output p = let segment_main_duration = segment_ticks * Lazy.force Frame.size in let segment_duration = Frame.seconds_of_main segment_main_duration in let segment_name = Lang.to_fun (List.assoc "segment_name" p) in - let segment_name ~position ~extname sname = - directory - ^^ Lang.to_string - (segment_name - [ - ("position", Lang.int position); - ("extname", Lang.string extname); - ("", Lang.string sname); - ]) + let segment_name ~position ~extname ~duration ~ticks sname = + Lang.to_string + (segment_name + [ + ( "", + Lang.record + [ + ("position", Lang.int position); + ("extname", Lang.string extname); + ("duration", Lang.float duration); + ("ticks", Lang.int ticks); + ("stream_name", Lang.string sname); + ] ); + ]) in let streams = let streams = Lang.assoc "" 2 p in @@ -598,7 +621,6 @@ class hls_output p = in let source = Lang.assoc "" 3 p in let main_playlist_filename = Lang.to_string (List.assoc "playlist" p) in - let main_playlist_filename = directory ^^ main_playlist_filename in let main_playlist_extra_tags = List.map (fun s -> String.trim (Lang.to_string s)) @@ -636,10 +658,7 @@ class hls_output p = | `Streaming, _ -> state <- `Streaming method private open_out filename = - let state = if Sys.file_exists filename then `Updated else `Created in - let temp_dir = - Option.value ~default:(Filename.dirname filename) temp_dir - in + let temp_dir = Option.value ~default:hls_directory temp_dir in let tmp_file = Filename.temp_file ~temp_dir "liq" "tmp" in Unix.chmod tmp_file perms; let fd = @@ -668,12 +687,20 @@ class hls_output p = in Bytes.sub_string b 0 (f 0) + val mutable saved_filename = None + method saved_filename = saved_filename + method close = (try Unix.close fd with _ -> ()); Fun.protect ~finally:(fun () -> try Sys.remove tmp_file with _ -> ()) (fun () -> - (try Unix.rename tmp_file filename + let fname = Filename.concat hls_directory (filename ()) in + saved_filename <- Some fname; + let state = + if Sys.file_exists fname then `Updated else `Created + in + (try Unix.rename tmp_file fname with Unix.Unix_error (Unix.EXDEV, _, _) -> self#log#important "Rename failed! Directory for temporary files appears to be \ @@ -682,9 +709,9 @@ class hls_output p = operations!"; Utils.copy ~mode:[Open_creat; Open_trunc; Open_binary] - ~perms tmp_file filename; + ~perms tmp_file fname; Sys.remove tmp_file); - on_file_change ~state filename) + on_file_change ~state fname) end method private unlink filename = @@ -695,11 +722,15 @@ class hls_output p = self#log#important "Could not remove file %s: %s" filename (Unix.error_message e) + method private unlink_segment = + function { filename = Some filename } -> self#unlink filename | _ -> () + method private close_segment = function | { current_segment = Some ({ out_channel = Some oc } as segment) } as s -> oc#close; + segment.filename <- oc#saved_filename; segment.out_channel <- None; let segments = List.assoc s.name segments in push_segment segment segments; @@ -709,7 +740,7 @@ class hls_output p = | Some max_segments -> List.length !segments >= max_segments then ( let segment = remove_segment segments in - self#unlink segment.filename; + self#unlink_segment segment; match segment.init_filename with | None -> () | Some filename -> @@ -728,20 +759,6 @@ class hls_output p = method private open_segment s = self#log#debug "Opening segment %d for stream %s." s.position s.name; - let filename = - segment_name ~position:s.position ~extname:s.extname s.name - in - let directory = Filename.dirname filename in - let () = - if (not (Sys.file_exists directory)) || not (Sys.is_directory directory) - then ( - try Utils.mkdir ~perm:dir_perm directory - with exn -> - let bt = Printexc.get_raw_backtrace () in - Lang.raise_as_runtime ~bt ~kind:"file" exn) - in - let out_channel = self#open_out filename in - Strings.iter out_channel#output_substring (s.encoder.Encoder.header ()); let discontinuous, current_discontinuity = if state = `Restarted then (true, s.discontinuity_count + 1) else (false, s.discontinuity_count) @@ -754,14 +771,23 @@ class hls_output p = discontinuous; current_discontinuity; len = 0; - filename; segment_extra_tags; init_filename = (match s.init_state with `Has_init f -> Some f | _ -> None); - out_channel = Some out_channel; + filename = None; + out_channel = None; last_segmentable_position = None; } in + let { position; extname } = s in + let filename () = + let ticks = segment.len in + let duration = Frame.seconds_of_main ticks in + segment_name ~position ~extname ~duration ~ticks s.name + in + let out_channel = self#open_out filename in + Strings.iter out_channel#output_substring (s.encoder.Encoder.header ()); + segment.out_channel <- Some out_channel; s.current_segment <- Some segment; s.discontinuity_count <- current_discontinuity; s.position <- s.position + 1; @@ -799,7 +825,7 @@ class hls_output p = method private cleanup_streams = List.iter - (fun (_, s) -> List.iter (fun s -> self#unlink s.filename) !s) + (fun (_, s) -> List.iter (fun s -> self#unlink_segment s) !s) segments; List.iter (fun s -> @@ -812,29 +838,35 @@ class hls_output p = (fun filename -> if Sys.file_exists filename then self#unlink filename) segment.init_filename); - self#unlink segment.filename) + self#unlink_segment segment) s.current_segment); s.current_segment <- None) streams - method private playlist_name s = directory ^^ s.name ^ ".m3u8" + method private playlist_name s = s.name ^ ".m3u8" method private write_playlist s = + let segments = + List.filter_map + (function + | { filename = Some fname } as s -> Some (fname, s) | _ -> None) + (List.rev !(List.assoc s.name segments)) + in let segments = List.fold_left (fun cur el -> if List.length cur < segments_per_playlist then el :: cur else cur) - [] - (List.rev !(List.assoc s.name segments)) + [] segments in let discontinuity_sequence, media_sequence = match segments with - | { current_discontinuity; id } :: _ -> (current_discontinuity, id - 1) + | (_, { current_discontinuity; id }) :: _ -> + (current_discontinuity, id - 1) | [] -> (0, 0) in let filename = self#playlist_name s in self#log#debug "Writing playlist %s.." s.name; - let oc = self#open_out filename in + let oc = self#open_out (fun () -> filename) in Fun.protect ~finally:(fun () -> oc#close) (fun () -> @@ -855,7 +887,7 @@ class hls_output p = oc#output_string "\r\n") s.stream_extra_tags; List.iteri - (fun pos segment -> + (fun pos (filename, segment) -> if 0 < pos && segment.discontinuous then oc#output_string "#EXT-X-DISCONTINUITY\r\n"; if pos = 0 || segment.discontinuous then ( @@ -878,8 +910,7 @@ class hls_output p = oc#output_string "\r\n") segment.segment_extra_tags; oc#output_string - (Printf.sprintf "%s%s\r\n" prefix - (Filename.basename segment.filename))) + (Printf.sprintf "%s%s\r\n" prefix (Filename.basename filename))) segments) val mutable main_playlist_written = false @@ -903,7 +934,7 @@ class hls_output p = | Some playlist -> self#log#debug "Writing main playlist %s.." main_playlist_filename; - let oc = self#open_out main_playlist_filename in + let oc = self#open_out (fun () -> main_playlist_filename) in oc#output_string playlist; oc#close)); main_playlist_written <- true @@ -1033,9 +1064,10 @@ class hls_output p = | None -> s.init_state <- `No_init | Some data when not (Strings.is_empty data) -> let init_filename = - segment_name ~position:init_position ~extname name + segment_name ~position:init_position ~extname ~duration:0. + ~ticks:0 name in - let oc = self#open_out init_filename in + let oc = self#open_out (fun () -> init_filename) in Fun.protect ~finally:(fun () -> oc#close) (fun () -> Strings.iter oc#output_substring data); diff --git a/src/libs/hls.liq b/src/libs/hls.liq index 4d666f80e9..0df4eda4b0 100644 --- a/src/libs/hls.liq +++ b/src/libs/hls.liq @@ -254,8 +254,8 @@ end def replaces output.harbor.hls( %argsof(output.file.hls[!segment_name]), ~segment_name=( - fun (~position, ~extname, stream_name) -> - "#{stream_name}_#{position}.#{extname}" + fun (metadata) -> + "#{metadata.stream_name}_#{metadata.position}.#{metadata.extname}" ), ~headers=[("Access-Control-Allow-Origin", "*")], ~port=8000, @@ -298,8 +298,8 @@ end def output.harbor.hls.https( %argsof(output.file.hls[!segment_name]), ~segment_name=( - fun (~position, ~extname, stream_name) -> - "#{stream_name}_#{position}.#{extname}" + fun (metadata) -> + "#{metadata.stream_name}_#{metadata.position}.#{metadata.extname}" ), ~headers=[("Access-Control-Allow-Origin", "*")], ~port=8000, diff --git a/tests/media/ffmpeg_distributed_hls.liq b/tests/media/ffmpeg_distributed_hls.liq index 0beff54e84..1c7bc98442 100644 --- a/tests/media/ffmpeg_distributed_hls.liq +++ b/tests/media/ffmpeg_distributed_hls.liq @@ -103,7 +103,8 @@ def check_stream() = end end -def segment_name(~position, ~extname, stream_name) = +def segment_name(metadata) = + let {position, extname, stream_name} = metadata if position > 10 then check_stream() end timestamp = int_of_float(time()) "#{stream_name}_#{timestamp}_#{position}.#{extname}" diff --git a/tests/media/ffmpeg_drop_tracks.liq b/tests/media/ffmpeg_drop_tracks.liq index 0738ead3d7..8f6f687bb5 100644 --- a/tests/media/ffmpeg_drop_tracks.liq +++ b/tests/media/ffmpeg_drop_tracks.liq @@ -100,7 +100,8 @@ def check_stream() = end end -def segment_name(~position, ~extname, stream_name) = +def segment_name(metadata) = + let {position, extname, stream_name} = metadata if position > 2 then check_stream() end timestamp = int_of_float(time()) "#{stream_name}_#{timestamp}_#{position}.#{extname}" diff --git a/tests/media/ffmpeg_raw_hls.liq b/tests/media/ffmpeg_raw_hls.liq index 3bf8e7543b..f97a90c1d8 100644 --- a/tests/media/ffmpeg_raw_hls.liq +++ b/tests/media/ffmpeg_raw_hls.liq @@ -98,8 +98,9 @@ def check_stream() = end end -def segment_name(~position, ~extname, stream_name) = - if position > 2 then check_stream() end +def segment_name(metadata) = + let {position, extname, stream_name} = metadata + if position > 1 then check_stream() end timestamp = int_of_float(time()) "#{stream_name}_#{timestamp}_#{position}.#{extname}" end diff --git a/tests/streams/hls_id3v2.liq b/tests/streams/hls_id3v2.liq index 0bd7f91a36..a653f14b14 100644 --- a/tests/streams/hls_id3v2.liq +++ b/tests/streams/hls_id3v2.liq @@ -180,8 +180,9 @@ s = mksafe(s) check_running = ref(false) segments_created = ref(0) -def segment_name(~position, ~extname, stream) = - "segment-#{stream}_#{position}.#{extname}" +def segment_name(metadata) = + let {position, extname, stream_name} = metadata + "segment-#{stream_name}_#{position}.#{extname}" end def on_file_change(~state, fname) = From 02565e0e455dff3d5146d8635cc2179a7875afa6 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 15 Sep 2024 16:06:01 -0500 Subject: [PATCH 015/151] Add metadata.parse.amplify. --- CHANGES.md | 29 +++++++++++++------------- src/core/builtins/builtins_metadata.ml | 12 +++++++++++ src/core/operators/amplify.ml | 9 ++++---- 3 files changed, 31 insertions(+), 19 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5b345bc6a4..881114a78a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -31,13 +31,13 @@ New: and taglib, with its dependency on the C++ runtime library, has been causing issues with binary builds portability and crashes with the (not yet supported) OCaml 5 compiler. (#4087) -- Add `video.canvas` to make it possible to position video elements independently +- Added `video.canvas` to make it possible to position video elements independently of the rendered video size ([#3656](https://github.com/savonet/liquidsoap/pull/3656), [blog post](https://www.liquidsoap.info/blog/2024-02-10-video-canvas-and-ai/)) -- Add cover manager from an original code by @vitoyucepi (#3651) +- Added cover manager from an original code by @vitoyucepi (#3651) - Added non-interleaved API to `%ffmpeg` encoder, enabled by default when only one stream is encoded. - Allow trailing commas in record definition (#3300). -- Add `metadata.getter.source.float` (#3356). +- Added `metadata.getter.source.float` (#3356). - BREAKING: Added `duration` and `ticks` to metadata available when computing HLS segment names (#4135) - Added optional `main_playlist_writer` to `output.file.hls` and derivated operator (#3484) @@ -45,16 +45,17 @@ New: - Added `%track.drop` to the `%ffmpeg` encoder to allow partial encoding of a source's available tracks (#3480) - Added `let { foo? } = ...` pattern matching (#3481) -- Add `metadata.replaygain` method to extract unified replay gain value from metadata (#3438). -- Add `compute` parameter to `file.replaygain` to control gain calculation (#3438). -- Add `compute` parameter to `enable_replaygain_metadata` to control replay gain calculation (#3438). -- Add `copy:` protocol (#3506) -- Add `file.touch`. -- Add support for sqlite databases (#3575). -- Add `string.of_int` and `string.spaces`. -- Add `list.assoc.nullable`. -- Add `source.cue` (#3620). -- Add `string.chars` (#4111) +- Added `metadata.replaygain` method to extract unified replay gain value from metadata (#3438). +- Added `metadata.parse.amplify` to manually parse amplify override metadata. +- Added `compute` parameter to `file.replaygain` to control gain calculation (#3438). +- Added `compute` parameter to `enable_replaygain_metadata` to control replay gain calculation (#3438). +- Added `copy:` protocol (#3506) +- Added `file.touch`. +- Added support for sqlite databases (#3575). +- Added `string.of_int` and `string.spaces`. +- Added `list.assoc.nullable`. +- Added `source.cue` (#3620). +- Added `string.chars` (#4111) - Added atomic file write operations. Changed: @@ -81,7 +82,7 @@ Changed: `runtime.gc.quick_stat()` (#3783). - Changed the port for the built-in Prometheus exporter to `9599` (#3801). - Set `segments_overheader` in HLS outputs to disable segments cleanup altogether. -- Add support for caching LV2 and LADSPA plugins (#3959). +- Added support for caching LV2 and LADSPA plugins (#3959). Fixed: diff --git a/src/core/builtins/builtins_metadata.ml b/src/core/builtins/builtins_metadata.ml index 31cace5def..447d4fea88 100644 --- a/src/core/builtins/builtins_metadata.ml +++ b/src/core/builtins/builtins_metadata.ml @@ -37,3 +37,15 @@ let _ = let m = Frame.Metadata.to_list (Lang.to_metadata (List.assoc "" p)) in let version = Lang.to_int (List.assoc "version" p) in Lang.string (Utils.id3v2_of_metadata ~version m)) + +let parse = Lang.add_module ~base:Modules.metadata "parse" + +let _ = + Lang.add_builtin ~base:parse "amplify" ~category:`String + ~descr: + "Parse an amplify metadata. Parsing is the same as in the `amplify` \ + operator. Metadata can be of the form: \" dB\" for a decibel-based \ + value or \"\" for a linear-based value. Returns a linear value." + [("", Lang.string_t, None, None)] + Lang.float_t + (fun p -> Lang.float (Amplify.parse_db (Lang.to_string (List.assoc "" p)))) diff --git a/src/core/operators/amplify.ml b/src/core/operators/amplify.ml index 276420cde9..7e3bc3e5ff 100644 --- a/src/core/operators/amplify.ml +++ b/src/core/operators/amplify.ml @@ -23,6 +23,9 @@ open Mm open Source +let parse_db s = + try Scanf.sscanf s " %f dB" Audio.lin_of_dB with _ -> float_of_string s + class amplify ~field (source : source) override_field coeff = object (self) inherit operator ~name:"track.audio.amplify" [source] @@ -68,11 +71,7 @@ class amplify ~field (source : source) override_field coeff = List.iter (fun (_, m) -> try - let s = Frame.Metadata.find f m in - let k = - try Scanf.sscanf s " %f dB" Audio.lin_of_dB - with _ -> float_of_string s - in + let k = parse_db (Frame.Metadata.find f m) in self#log#info "Overriding amplification: %f." k; override <- Some k with _ -> ()) From 7a41ac6b4af3a130adc5209130bcef2314b219f7 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 15 Sep 2024 16:13:24 -0500 Subject: [PATCH 016/151] Default to decibel values. --- src/core/builtins/builtins_metadata.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/core/builtins/builtins_metadata.ml b/src/core/builtins/builtins_metadata.ml index 447d4fea88..2b30835909 100644 --- a/src/core/builtins/builtins_metadata.ml +++ b/src/core/builtins/builtins_metadata.ml @@ -45,7 +45,10 @@ let _ = ~descr: "Parse an amplify metadata. Parsing is the same as in the `amplify` \ operator. Metadata can be of the form: \" dB\" for a decibel-based \ - value or \"\" for a linear-based value. Returns a linear value." + value or \"\" for a linear-based value. Returns a decibel value." [("", Lang.string_t, None, None)] Lang.float_t - (fun p -> Lang.float (Amplify.parse_db (Lang.to_string (List.assoc "" p)))) + (fun p -> + Lang.float + (Mm.Audio.dB_of_lin + (Amplify.parse_db (Lang.to_string (List.assoc "" p))))) From fee21c16fa789397fb7bc81c55c0bda0930ed1b4 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 20 Sep 2024 10:49:21 -0500 Subject: [PATCH 017/151] Update ROADMAP.md --- ROADMAP.md | 106 +++++++++++++++++++++++------------------------------ 1 file changed, 45 insertions(+), 61 deletions(-) diff --git a/ROADMAP.md b/ROADMAP.md index 7c399a99ea..cc081d5912 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -1,19 +1,50 @@ -## For 2.2 +## Backlog -### Done +- Explore new compiled backends +- Update the book + - Romain to document new internals +- Write article for ICFP +- support for ffmpeg subtitles +- use OCaml 5 (after it has matured) +- use native (as in native.liq) implementation of switch (based on + source.dynamic) +- reimplement video.tile in native liq +- rework buffer.adaptative +- use source getters for switch in order to be able to play two tracks ever day + (#2880) -- Separate language core (#2397) -- Online version (#2397) - - Available at: https://www.liquidsoap.info/try/ - - Needs some cleanup, definition of a minimal JS library. -- Switch to `dune` -- Separate standard library (in pure liq) -- support for multi-track audio -- live switch with ffmpeg encoded content -- deprecate "!" and ":=" in favor of x.get / x.set +### Maybe TODO: + +- remove requests and use sources instead everywhere (a request is a source with + one track [or more]) (weak maybe) + - Precise scheduling with queue.push, etc.: we could make the track available + at some precise time if requests were sources... + - this may allow stuff like `append` more easily +- Add support for modules, load minimal API by default +- Simple mechanism to tell source how much data will be expected in advance (e.g. 10s with cross) to allow automatic buffer management. +- Redefine switch-based transitions. + +### Nice to have + +- refine video support in order to have next liquidshop running on Liquidsoap + (dogfooding) +- use row variables for methods, using Garrigue's _Simple Type Inference for + Structural Polymorphism_ +- can we reimplement something like [melt](https://www.mltframework.org/)? ## For 2.2 +### Done + +- ~~Separate language core (#2397)~~ +- ~~Online version (#2397)~~ + - ~~Available at: https://www.liquidsoap.info/try/~~ + - ~~Needs some cleanup, definition of a minimal JS library.~~ +- ~~Switch to `dune`~~wh +- ~~Separate standard library (in pure liq)~~ +- ~~support for multi-track audio~~ +- l~~ive switch with ffmpeg encoded content~~ +- ~~deprecate "!" and ":=" in favor of x.get / x.set~~ - ~~switch to immutable content for metadata~~ - ~~Add script tooling, prettier etc.~~ - ~~switch to immutable content for frames (#2364)~~ @@ -29,55 +60,8 @@ - ~~Rewrite streaming loop~~ - ~~rewrite the clock system~~ - ~~the code is unreadable and overengineered ⇒ simplify it~~ - - we want to get rid of the assumption clock = thread - -### In progress - -- Optimize runtime: start time, typing and memory usage + - we want to get rid of the assumption clock = thread (Feasible but problem with OCaml 5) +- ~~Optimize runtime: start time, typing and memory usage~~ +- ~~javascrtipt/browser support using [WebCodecs](https://developer.mozilla.org/en-US/docs/Web/API/WebCodecs_API)!~~ -### TODO -- remove requests and use sources instead everywhere (a request is a source with - one track [or more]) - - Precise scheduling with queue.push, etc.: we could make the track available - at some precise time if requests were sources... - - this may allow stuff like `append` more easily - -### Maybe - -- Update the book - -## For 2.4 - -### Maybe - -- support for ffmpeg subtitles -- use OCaml 5 threads (#2879) -- Add support for modules, load minimal API by default - -## FOSDEM 2023 TODO - -- use source getters for switch in order to be able to play two tracks ever day - (#2880) -- use naive (as in native.liq) implementation of switch (based on - source.dynamic) -- rework buffer.adaptative -- allow showing graphs (of buffer.adaptative for instance) -- reimplement video.tile in native liq - -## Backlog - -- Simple mechanism to tell source how much data will be expected in advance (e.g. 10s with cross) to allow automatic buffer management. -- Redefine switch-based transitions. -- javascrtipt/browser support using [WebCodecs](https://developer.mozilla.org/en-US/docs/Web/API/WebCodecs_API)! -- refine video support in order to have next liquidshop running on Liquidsoap - (dogfooding) -- native RTMP support (and ensure that HLS output is easy to use) -- rewrite switch / sequence / etc. operators based on only one binary operator: - fallback - - note: predicates can ben encoded in availability - - transitions might be tricky... we want to make them on the Liquidsoap side - using cross and a tag system to know from which source we come -- use row variables for methods, using Garrigue's _Simple Type Inference for - Structural Polymorphism_ -- can we reimplement something like [melt](https://www.mltframework.org/)? From 1a84931abbf0dc6060c0b6a1f3557881c08aaefb Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 21 Sep 2024 11:52:58 -0500 Subject: [PATCH 018/151] Format ROADMAP.md --- ROADMAP.md | 2 -- 1 file changed, 2 deletions(-) diff --git a/ROADMAP.md b/ROADMAP.md index cc081d5912..adfdd6e1d8 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -63,5 +63,3 @@ - we want to get rid of the assumption clock = thread (Feasible but problem with OCaml 5) - ~~Optimize runtime: start time, typing and memory usage~~ - ~~javascrtipt/browser support using [WebCodecs](https://developer.mozilla.org/en-US/docs/Web/API/WebCodecs_API)!~~ - - From c4a4a85bd50413276196e550a634785982ed8450 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 21 Sep 2024 11:54:50 -0500 Subject: [PATCH 019/151] Build with vx.y.z-* --- .github/workflows/ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b10082a3f5..ad315403c9 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -7,6 +7,7 @@ on: - main - rolling-release-* - v[0-9]+.[0-9]+.[0-9]+ + - v[0-9]+.[0-9]+.[0-9]+-* concurrency: group: ${{ github.workflow }}-${{ github.ref }} From 21ce02e68593ce24d7c60cdc0168ac642a9e8737 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 24 Sep 2024 09:05:26 -0500 Subject: [PATCH 020/151] Update to latest TLS API. (#4141) --- .github/scripts/build-posix.sh | 2 +- dune-project | 2 +- liquidsoap-core.opam | 2 +- src/core/builtins/builtins_tls.ml | 35 ++++++++++++++++++------------- 4 files changed, 23 insertions(+), 18 deletions(-) diff --git a/.github/scripts/build-posix.sh b/.github/scripts/build-posix.sh index 1ea3c34773..717eebb70c 100755 --- a/.github/scripts/build-posix.sh +++ b/.github/scripts/build-posix.sh @@ -50,7 +50,7 @@ cd .. opam update opam remove -y jemalloc -opam install -y tls.0.17.4 saturn_lockfree.0.4.1 ppx_hash +opam install -y tls.1.0.2 saturn_lockfree.0.4.1 ppx_hash cd /tmp/liquidsoap-full diff --git a/dune-project b/dune-project index 2835a834f7..0c767f70fc 100644 --- a/dune-project +++ b/dune-project @@ -136,7 +136,7 @@ (speex (< 0.4.0)) (srt (< 0.3.0)) (ssl (< 0.7.0)) - (tls (< 0.17.4)) + (tls (< 1.0.2)) (sdl-liquidsoap (< 2)) (theora (< 0.4.0)) (vorbis (< 0.8.0)) diff --git a/liquidsoap-core.opam b/liquidsoap-core.opam index 3194abb84f..354fa11dd0 100644 --- a/liquidsoap-core.opam +++ b/liquidsoap-core.opam @@ -104,7 +104,7 @@ conflicts: [ "speex" {< "0.4.0"} "srt" {< "0.3.0"} "ssl" {< "0.7.0"} - "tls" {< "0.17.4"} + "tls" {< "1.0.2"} "sdl-liquidsoap" {< "2"} "theora" {< "0.4.0"} "vorbis" {< "0.8.0"} diff --git a/src/core/builtins/builtins_tls.ml b/src/core/builtins/builtins_tls.ml index 231bff9741..a7a2be676d 100644 --- a/src/core/builtins/builtins_tls.ml +++ b/src/core/builtins/builtins_tls.ml @@ -44,12 +44,12 @@ module Liq_tls = struct (Tls.Packet.alert_type_to_string typ) let write_all ~timeout fd data = - Tutils.write_all ~timeout fd (Cstruct.to_bytes data) + Tutils.write_all ~timeout fd (Bytes.unsafe_of_string data) let read ~timeout h len = Tutils.wait_for (`Read h.fd) timeout; let n = Unix.read h.fd h.buf 0 (min len buf_len) in - Cstruct.of_bytes ~len:n h.buf + Bytes.sub_string h.buf 0 n let read_pending h = function | None -> () @@ -69,7 +69,7 @@ module Liq_tls = struct "tls" | Ok (state, None, `Response response, `Data data) -> h.state <- state; - read_pending h data; + read_pending h (Option.map Cstruct.of_string data); write_response ~timeout h response; f () | Error (error, `Response response) -> @@ -101,7 +101,7 @@ module Liq_tls = struct let write ?timeout h b off len = let timeout = Option.value ~default:Harbor_base.conf_timeout#get timeout in match - Tls.Engine.send_application_data h.state [Cstruct.of_bytes ~off ~len b] + Tls.Engine.send_application_data h.state [Bytes.sub_string b off len] with | None -> len | Some (state, data) -> @@ -136,12 +136,11 @@ module Liq_tls = struct | Some `Eof, None -> 0 | _, None -> f () | _, Some data -> - let data_len = Cstruct.length data in + let data_len = String.length data in let n = min data_len len in - Cstruct.blit_to_bytes data 0 b off n; + Bytes.blit_string data 0 b off n; if n < data_len then - Buffer.add_string h.read_pending - (Cstruct.to_string data ~off:n ~len:(data_len - n)); + Buffer.add_substring h.read_pending data n (data_len - n); n) | Error (error, `Response response) -> write_all ~timeout:write_timeout h.fd response; @@ -182,16 +181,18 @@ let tls_socket ~session transport = let server ~read_timeout ~write_timeout ~certificate ~key transport = let server = try - let certificate = Cstruct.of_string (Utils.read_all (certificate ())) in + let certificate = Utils.read_all (certificate ()) in let certificates = Result.get_ok (X509.Certificate.decode_pem_multiple certificate) in let key = - Result.get_ok - (X509.Private_key.decode_pem - (Cstruct.of_string (Utils.read_all (key ())))) + Result.get_ok (X509.Private_key.decode_pem (Utils.read_all (key ()))) in - Tls.Config.server ~certificates:(`Single (certificates, key)) () + match + Tls.Config.server ~certificates:(`Single (certificates, key)) () + with + | Ok server -> server + | Error (`Msg message) -> Runtime_error.raise ~pos:[] ~message "tls" with exn -> let bt = Printexc.get_raw_backtrace () in Lang.raise_as_runtime ~bt ~kind:"tls" exn @@ -226,7 +227,7 @@ let transport ~read_timeout ~write_timeout ~certificate ~key () = let certificates = Result.get_ok (X509.Certificate.decode_pem_multiple - (Cstruct.of_string (Utils.read_all (certificate ())))) + (Utils.read_all (certificate ()))) in Some (X509.Authenticator.chain_of_trust @@ -241,7 +242,11 @@ let transport ~read_timeout ~write_timeout ~certificate ~key () = let r = auth ?ip ~host certs in if Result.is_ok r then r else authenticator ?ip ~host certs in - let client = Tls.Config.client ~authenticator ~peer_name:domain () in + let client = + match Tls.Config.client ~authenticator ~peer_name:domain () with + | Ok client -> client + | Error (`Msg message) -> Runtime_error.raise ~pos:[] ~message "tls" + in let fd = Http.connect ?bind_address ~timeout ?prefer host port in let session = Liq_tls.init_client ~timeout ~client fd in tls_socket ~session self From bf6b857726e009a8143ef5d80a2d293fdf6509c6 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 24 Sep 2024 13:46:57 -0500 Subject: [PATCH 021/151] Keep builtins at runtime (#4142) --- src/lang/environment.ml | 3 +-- src/lang/environment.mli | 2 +- src/runtime/main.ml | 2 +- tests/language/process.liq | 2 ++ tests/regression/GH4140.liq | 8 ++++++++ tests/regression/dune.inc | 16 ++++++++++++++++ 6 files changed, 29 insertions(+), 4 deletions(-) create mode 100644 tests/regression/GH4140.liq diff --git a/src/lang/environment.ml b/src/lang/environment.ml index 3709335e0f..d1edd0b5b7 100644 --- a/src/lang/environment.ml +++ b/src/lang/environment.ml @@ -34,9 +34,8 @@ let default_typing_environment () = Env.bindings !type_environment [get_builtins]. *) let flat_enviroment : (string * (Type.scheme * Value.t)) list ref = ref [] -let clear_environments () = +let clear_toplevel_environments () = type_environment := Env.empty; - value_environment := Env.empty; flat_enviroment := [] let has_builtin name = List.mem_assoc name !flat_enviroment diff --git a/src/lang/environment.mli b/src/lang/environment.mli index 4dede538f4..2557b70b76 100644 --- a/src/lang/environment.mli +++ b/src/lang/environment.mli @@ -49,4 +49,4 @@ val default_typing_environment : unit -> (string * Type.scheme) list val default_environment : unit -> (string * Value.t) list (** Clear all environments. *) -val clear_environments : unit -> unit +val clear_toplevel_environments : unit -> unit diff --git a/src/runtime/main.ml b/src/runtime/main.ml index 117bd2c976..a376d47205 100644 --- a/src/runtime/main.ml +++ b/src/runtime/main.ml @@ -113,7 +113,7 @@ let eval_script expr = (Lang.eval ~toplevel ~cache:!cache ~stdlib ~deprecated:!deprecated ~name:"main script" expr); if not (Lang_eval.effective_toplevel ~stdlib toplevel) then - Environment.clear_environments () + Environment.clear_toplevel_environments () (** Evaluate the user script. *) let eval () = diff --git a/tests/language/process.liq b/tests/language/process.liq index 3719a58bab..67df15370c 100644 --- a/tests/language/process.liq +++ b/tests/language/process.liq @@ -1,3 +1,5 @@ +test.skip() + first = ref(true) thread.run.recurrent( { diff --git a/tests/regression/GH4140.liq b/tests/regression/GH4140.liq new file mode 100644 index 0000000000..7ec08e5f8c --- /dev/null +++ b/tests/regression/GH4140.liq @@ -0,0 +1,8 @@ +daytime = time.predicate("9h-21h") + +def f() = + print(daytime()) + test.pass() +end + +test.check(f) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index 2ba814c12a..cbb88d2629 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -703,6 +703,22 @@ (:run_test ../run_test.exe)) (action (run %{run_test} GH4124.liq liquidsoap %{test_liq} GH4124.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + GH4140.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} GH4140.liq liquidsoap %{test_liq} GH4140.liq))) + (rule (alias citest) (package liquidsoap) From 7b881cc3014c0134ea222161d5623c2283e1d1f2 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 27 Sep 2024 09:15:38 -0500 Subject: [PATCH 022/151] Fix call to `string.length` (#4145) --- src/libs/extra/audio.liq | 2 +- src/libs/file.liq | 6 +++--- src/libs/http.liq | 30 ++++++++++++++++++++++------- src/libs/protocols.liq | 2 +- src/libs/string.liq | 18 +++++++++++++++--- tests/regression/GH4144.liq | 38 +++++++++++++++++++++++++++++++++++++ tests/regression/dune.inc | 16 ++++++++++++++++ 7 files changed, 97 insertions(+), 15 deletions(-) create mode 100644 tests/regression/GH4144.liq diff --git a/src/libs/extra/audio.liq b/src/libs/extra/audio.liq index 1b5213f12f..e33ffc4033 100644 --- a/src/libs/extra/audio.liq +++ b/src/libs/extra/audio.liq @@ -303,7 +303,7 @@ end def replaces dtmf(~duration=0.1, ~delay=0.05, dtmf) = l = ref([]) for i = 0 to - string.length(encoding="ascii", dtmf) - 1 + string.bytes.length(dtmf) - 1 do c = string.sub(encoding="ascii", dtmf, start=i, length=1) let (row, col) = diff --git a/src/libs/file.liq b/src/libs/file.liq index d6c51274d1..fc5a0960c2 100644 --- a/src/libs/file.liq +++ b/src/libs/file.liq @@ -321,10 +321,10 @@ def file.metadata.flac.cover.encode( data ) = def encode_string(s) = - len = 1 + (string.length(encoding="ascii", s) / 8) + len = 1 + (string.bytes.length(s) / 8) str_len = string.binary.of_int(little_endian=false, pad=4, len) if - string.length(encoding="ascii", str_len) > 4 + string.bytes.length(str_len) > 4 then error.raise( error.invalid, @@ -332,7 +332,7 @@ def file.metadata.flac.cover.encode( ) end - pad = string.make(char_code=0, len * 8 - string.length(encoding="ascii", s)) + pad = string.make(char_code=0, len * 8 - string.bytes.length(s)) (str_len, "#{s}#{pad}") end diff --git a/src/libs/http.liq b/src/libs/http.liq index a9fe3eef8f..cece16dd1b 100644 --- a/src/libs/http.liq +++ b/src/libs/http.liq @@ -139,10 +139,11 @@ def http.response( getter.is_constant(data) then data = getter.get(data) + len = string.bytes.length(data) if data != "" then - ("Content-Length", "#{string.length(data)}")::headers + ("Content-Length", "#{len}")::headers else headers end @@ -180,7 +181,7 @@ def http.response( getter.get(data) else data = getter.get(data) - len = string.length(encoding="ascii", data) + len = string.bytes.length(data) response_ended := data == "" "#{string.hex_of_int(len)}\r\n#{data}\r\n" end @@ -308,7 +309,10 @@ end # @flag hidden def harbor.http.regexp_of_path(path) = def named_capture(s) = - name = string.sub(encoding="ascii", s, start=1, length=string.length(encoding="ascii", s) - 1) + name = + string.sub( + encoding="ascii", s, start=1, length=string.bytes.length(s) - 1 + ) "(?<#{name}>[^/]+)" end @@ -510,7 +514,13 @@ def harbor.http.static.base( basepath = if - string.sub(encoding="ascii", basepath, start=string.length(encoding="ascii", basepath) - 1, length=1) != "/" + string.sub( + encoding="ascii", + basepath, + start=string.bytes.length(basepath) - 1, + length=1 + ) != + "/" then basepath ^ "/" else @@ -585,8 +595,14 @@ end # @flag hidden def http.string_of_float(x) = s = string(x) - n = string.length(encoding="ascii", s) - if string.sub(encoding="ascii", s, start=n - 1, length=1) == "." then s ^ "0" else s end + n = string.bytes.length(s) + if + string.sub(encoding="ascii", s, start=n - 1, length=1) == "." + then + s ^ "0" + else + s + end end # @flag hidden @@ -948,7 +964,7 @@ def http.headers.content_disposition(headers) = type: string, filename?: string, name?: string, - args: [(string*string?)] + args: [(string * string?)] } ) end, diff --git a/src/libs/protocols.liq b/src/libs/protocols.liq index 67d1afe240..5fb5b9397f 100644 --- a/src/libs/protocols.liq +++ b/src/libs/protocols.liq @@ -429,7 +429,7 @@ def protocol.ffmpeg(~rlog, ~maxtime, arg) = end m = string.concat(separator=",", list.map(f, m)) - if string.length(encoding="ascii", m) > 0 then "annotate:#{m}:" else "" end + if string.bytes.length(m) > 0 then "annotate:#{m}:" else "" end end def parse_metadata(file) = diff --git a/src/libs/string.liq b/src/libs/string.liq index a03310aa4f..aa9dd93f2f 100644 --- a/src/libs/string.liq +++ b/src/libs/string.liq @@ -35,6 +35,18 @@ def string.split(~separator, s) = regexp(separator).split(s) end +# Return an array of the string's bytes. +# @category String +def string.bytes(s) = + string.split(separator="", s) +end + +# Return the length of the string in bytes. +# @category String +def string.bytes.length(s) = + string.length(encoding="ascii", s) +end + # Split a string in two at first "separator". # @category String def string.split.first(~encoding=null(), ~separator, s) = @@ -170,7 +182,7 @@ def string.of_int(~digits=0, n) = then s else - string.make(char_code=48, digits - string.length(s)) ^ s + string.make(char_code=48, digits - string.bytes.length(s)) ^ s end end @@ -189,7 +201,7 @@ let string.binary = () # @param s String containing the binary representation. def string.binary.to_int(~little_endian=true, s) = ans = ref(0) - n = string.length(encoding="ascii", s) + n = string.bytes.length(s) for i = 0 to n - 1 do @@ -225,7 +237,7 @@ def string.binary.of_int(~pad=0, ~little_endian=true, d) = ret = d == 0 ? "\\x00" : f(d, "") ret = string.unescape(ret) - len = string.length(encoding="ascii", ret) + len = string.bytes.length(ret) if len < pad then diff --git a/tests/regression/GH4144.liq b/tests/regression/GH4144.liq new file mode 100644 index 0000000000..a7fdf078a3 --- /dev/null +++ b/tests/regression/GH4144.liq @@ -0,0 +1,38 @@ +def metadata_test(_) = + data = {test={test="好吗"}} + try + http.response( + status_code=200, + headers= + [ + ("Content-Type", "application/json"), + ("Access-Control-Allow-Origin", "*") + ], + content_type= + "application/json; charset=UTF-8", + data=json.stringify(data, compact=true) + ) + catch error do + log.severe(error.message, label="http") + http.response( + status_code=500, + content_type= + "application/json; charset=UTF-8", + data= + '{"status"="error","message"="Failed to serialize response data"}' ^ + "\n" + ) + end +end + +port = 4144 + +harbor.http.register.simple("/test", metadata_test, port=port, method="GET") + +def check() = + resp = http.get("http://localhost:#{port}/test") + test.equal(resp, '{"test":{"test":"好吗"}}') + test.pass() +end + +test.check(check) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index cbb88d2629..9d6ac8cab1 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -719,6 +719,22 @@ (:run_test ../run_test.exe)) (action (run %{run_test} GH4140.liq liquidsoap %{test_liq} GH4140.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + GH4144.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} GH4144.liq liquidsoap %{test_liq} GH4144.liq))) + (rule (alias citest) (package liquidsoap) From a48a837bb7129d50ba74fec8768e05f56dd86694 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 27 Sep 2024 09:35:13 -0500 Subject: [PATCH 023/151] Fix pre-commit. --- doc/content/liq/regular.liq | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/content/liq/regular.liq b/doc/content/liq/regular.liq index 2b96b31053..a8b9ba9a63 100644 --- a/doc/content/liq/regular.liq +++ b/doc/content/liq/regular.liq @@ -1,8 +1,10 @@ promotions = sine() other_source = sine() + # BEGIN # (1200 sec = 20 min) timed_promotions = delay(1200., promotions) main_source = fallback([timed_promotions, other_source]) + # END output.dummy(main_source) From df10d82b5d564f497815d250276341243e7ab56a Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 28 Sep 2024 10:11:54 -0500 Subject: [PATCH 024/151] Change the default amplify behavior in autocue. --- src/libs/autocue.liq | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index 3e86781910..52beda3bc1 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -28,11 +28,12 @@ let settings.autocue.preferred = let settings.autocue.amplify_behavior = settings.make( description= - "How to proceed with amplify data when `\"liq_amplify\"` is set. One of: \ - `\"keep\"` (prefer user-provided value), `\"override\"` (always override \ - with computed value), `\"ignore\"` (ignore/suppress loudness \ - adjustment).", - "keep" + "How to proceed with loudness adjustment. Set to `\"override\"` to always prefer + the value provided by the `autocue` provider. Set to `\"ignore\"` to ignore all + loudness correction provided via the `autocue` provider. Set to + `\"keep\"` to always prefer user-provided values (via request annotation or file tags) + over values provided by the `autocue` provider.", + "override" ) let settings.autocue.amplify_aliases = @@ -976,10 +977,12 @@ def enable_autocue_metadata() = label="autocue.metadata", "User-supplied amplify metadata detected: #{ user_supplied_amplify_labels - }, overriding with data." + }, overriding with autocue data." ) [ - ...list.assoc.remove("liq_amplify", autocue_metadata), + ...autocue_metadata, + # This replaces all user-provided tags with the value returned by + # the autocue implementation. ...list.map( fun (lbl) -> (lbl, autocue_metadata["liq_amplify"]), user_supplied_amplify From c8ee9992cf624756e1dbf43d05fb91e0fdbe7b5b Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 28 Sep 2024 10:12:59 -0500 Subject: [PATCH 025/151] Initialize ffmpeg filter input clocks as passive clocks. (#4146) --- src/core/clock.ml | 11 ++++++++--- src/core/clock.mli | 1 + src/core/io/ffmpeg_filter_io.ml | 3 ++- src/core/source.ml | 4 ++-- 4 files changed, 13 insertions(+), 6 deletions(-) diff --git a/src/core/clock.ml b/src/core/clock.ml index 884327ac71..79bb50dd7e 100644 --- a/src/core/clock.ml +++ b/src/core/clock.ml @@ -234,7 +234,7 @@ and stop c = x.log#debug "Clock stopping"; Atomic.set clock.state (`Stopping x) -let started = Atomic.make false +let clocks_started = Atomic.make false let global_stop = Atomic.make false exception Has_stopped @@ -362,6 +362,11 @@ let _after_tick ~clock x = x.log#severe "We must catchup %.2f seconds!" Time.(to_float (end_time |-| target_time))) +let started c = + match Atomic.get (Unifier.deref c).state with + | `Stopping _ | `Started _ -> true + | `Stopped _ -> false + let rec active_params c = match Atomic.get (Unifier.deref c).state with | `Stopping s | `Started s -> s @@ -452,7 +457,7 @@ and _can_start ?(force = false) clock = match s#source_type with `Output _ -> true | _ -> false) in let can_start = - (not (Atomic.get global_stop)) && (force || Atomic.get started) + (not (Atomic.get global_stop)) && (force || Atomic.get clocks_started) in match (can_start, has_output, Atomic.get clock.state) with | true, _, `Stopped (`Passive as sync) | true, true, `Stopped sync -> @@ -538,7 +543,7 @@ let start_pending () = let () = Lifecycle.before_start ~name:"Clocks start" (fun () -> - Atomic.set started true; + Atomic.set clocks_started true; start_pending ()) let on_tick c fn = diff --git a/src/core/clock.mli b/src/core/clock.mli index 91baea98d7..e3f29827b1 100644 --- a/src/core/clock.mli +++ b/src/core/clock.mli @@ -92,6 +92,7 @@ val id : t -> string val descr : t -> string val sync : t -> sync_mode val start : ?force:bool -> t -> unit +val started : t -> bool val stop : t -> unit val set_stack : t -> Liquidsoap_lang.Pos.t list -> unit val self_sync : t -> bool diff --git a/src/core/io/ffmpeg_filter_io.ml b/src/core/io/ffmpeg_filter_io.ml index c8378e5419..4de2552ba5 100644 --- a/src/core/io/ffmpeg_filter_io.ml +++ b/src/core/io/ffmpeg_filter_io.ml @@ -82,8 +82,9 @@ class virtual ['a] base_output ~pass_metadata ~name ~frame_t ~field source = object (self) inherit Output.output + ~clock:(Clock.create ~sync:`Passive ~id:name ()) ~infallible:false ~register_telnet:false ~on_stop:noop ~on_start:noop - ~name ~output_kind:"ffmpeg.filter.input" (Lang.source source) true as super + ~name ~output_kind:"ffmpeg.filter.input" (Lang.source source) true as super inherit ['a] duration_converter diff --git a/src/core/source.ml b/src/core/source.ml index 7883e4e574..a34dcc9da6 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -238,8 +238,8 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = List.iter (fun fn -> fn ()) on_sleep) method sleep = - match Atomic.get streaming_state with - | `Ready _ | `Unavailable -> + match (Clock.started self#clock, Atomic.get streaming_state) with + | true, (`Ready _ | `Unavailable) -> Clock.after_tick self#clock (fun () -> self#force_sleep) | _ -> self#force_sleep From c4746c81d913d84e016993b2aaa77aa08db99e54 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 28 Sep 2024 10:21:09 -0500 Subject: [PATCH 026/151] Move doc generation to liquidsoap package, add pandoc and pandoc-include as doc deps. Fixes: #4143 --- doc/dune.inc | 151 ++++++++++++++++++++++++++++++++++++++++++++++++ doc/gen_dune.ml | 4 ++ dune-project | 4 +- liquidsoap.opam | 2 + 4 files changed, 160 insertions(+), 1 deletion(-) diff --git a/doc/dune.inc b/doc/dune.inc index fa227dafb3..0f1f2fdff0 100644 --- a/doc/dune.inc +++ b/doc/dune.inc @@ -1,6 +1,7 @@ (rule (alias doc) + (package liquidsoap) (deps (source_tree ../src/libs)) @@ -12,6 +13,7 @@ (rule (alias doc) + (package liquidsoap) (deps (:header content/reference-header.md) (source_tree ../src/libs)) @@ -25,6 +27,7 @@ (rule (alias doc) + (package liquidsoap) (deps (:header content/reference-header.md) (source_tree ../src/libs)) @@ -38,6 +41,7 @@ (rule (alias doc) + (package liquidsoap) (deps (:header content/reference-header.md) (source_tree ../src/libs)) @@ -51,6 +55,7 @@ (rule (alias doc) + (package liquidsoap) (deps (source_tree ../src/libs)) @@ -62,6 +67,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target protocols.html) @@ -70,6 +76,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -188,6 +195,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target reference.html) @@ -196,6 +204,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -314,6 +323,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target reference-extras.html) @@ -322,6 +332,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -440,6 +451,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target reference-deprecated.html) @@ -448,6 +460,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -566,6 +579,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target settings.html) @@ -574,6 +588,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -692,6 +707,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target beets.html) @@ -700,6 +716,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -818,6 +835,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target blank.html) @@ -826,6 +844,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -944,6 +963,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target book.html) @@ -952,6 +972,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -1070,6 +1091,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target build.html) @@ -1078,6 +1100,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -1196,6 +1219,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target clocks.html) @@ -1204,6 +1228,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -1322,6 +1347,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target complete_case.html) @@ -1330,6 +1356,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -1448,6 +1475,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target cookbook.html) @@ -1456,6 +1484,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -1574,6 +1603,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target crossfade.html) @@ -1582,6 +1612,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -1700,6 +1731,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target custom-path.html) @@ -1708,6 +1740,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -1826,6 +1859,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target database.html) @@ -1834,6 +1868,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -1952,6 +1987,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target documentation.html) @@ -1960,6 +1996,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -2078,6 +2115,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target dynamic_sources.html) @@ -2086,6 +2124,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -2204,6 +2243,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target encoding_formats.html) @@ -2212,6 +2252,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -2330,6 +2371,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target external_decoders.html) @@ -2338,6 +2380,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -2456,6 +2499,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target external_encoders.html) @@ -2464,6 +2508,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -2582,6 +2627,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target external_streams.html) @@ -2590,6 +2636,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -2708,6 +2755,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target faq.html) @@ -2716,6 +2764,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -2834,6 +2883,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target ffmpeg.html) @@ -2842,6 +2892,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -2960,6 +3011,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target ffmpeg_cookbook.html) @@ -2968,6 +3020,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -3086,6 +3139,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target ffmpeg_encoder.html) @@ -3094,6 +3148,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -3212,6 +3267,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target ffmpeg_filters.html) @@ -3220,6 +3276,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -3338,6 +3395,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target flows_devel.html) @@ -3346,6 +3404,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -3464,6 +3523,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target frequence3.html) @@ -3472,6 +3532,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -3590,6 +3651,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target geekradio.html) @@ -3598,6 +3660,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -3716,6 +3779,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target harbor.html) @@ -3724,6 +3788,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -3842,6 +3907,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target harbor_http.html) @@ -3850,6 +3916,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -3968,6 +4035,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target help.html) @@ -3976,6 +4044,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -4094,6 +4163,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target hls_output.html) @@ -4102,6 +4172,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -4220,6 +4291,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target http_input.html) @@ -4228,6 +4300,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -4346,6 +4419,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target icy_metadata.html) @@ -4354,6 +4428,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -4472,6 +4547,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target in_production.html) @@ -4480,6 +4556,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -4598,6 +4675,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target index.html) @@ -4606,6 +4684,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -4724,6 +4803,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target install.html) @@ -4732,6 +4812,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -4850,6 +4931,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target json.html) @@ -4858,6 +4940,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -4976,6 +5059,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target ladspa.html) @@ -4984,6 +5068,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -5102,6 +5187,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target language.html) @@ -5110,6 +5196,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -5228,6 +5315,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target memory.html) @@ -5236,6 +5324,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -5354,6 +5443,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target metadata.html) @@ -5362,6 +5452,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -5480,6 +5571,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target migrating.html) @@ -5488,6 +5580,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -5606,6 +5699,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target multitrack.html) @@ -5614,6 +5708,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -5732,6 +5827,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target on2.html) @@ -5740,6 +5836,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -5858,6 +5955,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target phases.html) @@ -5866,6 +5964,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -5984,6 +6083,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target playlist_parsers.html) @@ -5992,6 +6092,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -6110,6 +6211,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target presentations.html) @@ -6118,6 +6220,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -6236,6 +6339,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target profiling.html) @@ -6244,6 +6348,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -6362,6 +6467,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target prometheus.html) @@ -6370,6 +6476,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -6488,6 +6595,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target protocols-presentation.html) @@ -6496,6 +6604,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -6614,6 +6723,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target publications.html) @@ -6622,6 +6732,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -6740,6 +6851,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target quick_start.html) @@ -6748,6 +6860,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -6866,6 +6979,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target radiopi.html) @@ -6874,6 +6988,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -6992,6 +7107,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target reference-header.html) @@ -7000,6 +7116,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -7118,6 +7235,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target release-assets.html) @@ -7126,6 +7244,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -7244,6 +7363,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target replay_gain.html) @@ -7252,6 +7372,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -7370,6 +7491,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target request_sources.html) @@ -7378,6 +7500,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -7496,6 +7619,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target requests.html) @@ -7504,6 +7628,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -7622,6 +7747,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target rolling-release.html) @@ -7630,6 +7756,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -7748,6 +7875,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target script_loading.html) @@ -7756,6 +7884,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -7874,6 +8003,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target seek.html) @@ -7882,6 +8012,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -8000,6 +8131,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target server.html) @@ -8008,6 +8140,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -8126,6 +8259,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target shoutcast.html) @@ -8134,6 +8268,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -8252,6 +8387,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target sources.html) @@ -8260,6 +8396,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -8378,6 +8515,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target split-cue.html) @@ -8386,6 +8524,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -8504,6 +8643,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target stereotool.html) @@ -8512,6 +8652,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -8630,6 +8771,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target stream_content.html) @@ -8638,6 +8780,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -8756,6 +8899,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target strings_encoding.html) @@ -8764,6 +8908,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -8882,6 +9027,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target video-static.html) @@ -8890,6 +9036,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -9008,6 +9155,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target video.html) @@ -9016,6 +9164,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml @@ -9134,6 +9283,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if (not %{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target yaml.html) @@ -9142,6 +9292,7 @@ (rule (alias doc) + (package liquidsoap) (enabled_if %{bin-available:pandoc}) (deps liquidsoap.xml diff --git a/doc/gen_dune.ml b/doc/gen_dune.ml index 48ac7575a9..62ca40a565 100644 --- a/doc/gen_dune.ml +++ b/doc/gen_dune.ml @@ -33,6 +33,7 @@ let mk_subst_rule f = {| (rule (alias doc) + (package liquidsoap) (deps (:subst_md ./subst_md.exe) (:in_md content/%s)) @@ -48,6 +49,7 @@ let mk_html_rule ~liq ~content f = {| (rule (alias doc) + (package liquidsoap) (enabled_if (not %%{bin-available:pandoc})) (deps (:no_pandoc no-pandoc)) (target %s) @@ -56,6 +58,7 @@ let mk_html_rule ~liq ~content f = (rule (alias doc) + (package liquidsoap) (enabled_if %%{bin-available:pandoc}) (deps liquidsoap.xml @@ -95,6 +98,7 @@ let mk_generated_rule (file, option, header) = {| (rule (alias doc) + (package liquidsoap) (deps %s (source_tree ../src/libs)) diff --git a/dune-project b/dune-project index 0c767f70fc..e824a12ea1 100644 --- a/dune-project +++ b/dune-project @@ -18,7 +18,9 @@ (depends (liquidsoap-core (= :version)) (liquidsoap-libs (and (>= 2.3.0) (< 2.3.1))) - (liquidsoap-libs-extra (and (>= 2.3.0) (< 2.3.1)))) + (liquidsoap-libs-extra (and (>= 2.3.0) (< 2.3.1))) + (pandoc :with-doc) + (pandoc-include :with-doc)) (synopsis "Swiss-army knife for multimedia streaming") (description "\| Liquidsoap is a powerful and flexible language for describing your diff --git a/liquidsoap.opam b/liquidsoap.opam index e36b85f0cc..c27d8ca4d5 100644 --- a/liquidsoap.opam +++ b/liquidsoap.opam @@ -20,6 +20,8 @@ depends: [ "liquidsoap-core" {= version} "liquidsoap-libs" {>= "2.3.0" & < "2.3.1"} "liquidsoap-libs-extra" {>= "2.3.0" & < "2.3.1"} + "pandoc" {with-doc} + "pandoc-include" {with-doc} "odoc" {with-doc} ] build: [ From 7c0bbfcab42dce6a96eaed55a032dfed3325cf20 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 29 Sep 2024 14:30:56 -0500 Subject: [PATCH 027/151] bump number of queues. --- src/core/tools/tutils.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/tools/tutils.ml b/src/core/tools/tutils.ml index 219f08cd08..c4f5e37caa 100644 --- a/src/core/tools/tutils.ml +++ b/src/core/tools/tutils.ml @@ -71,7 +71,7 @@ let exit () = let generic_queues = Dtools.Conf.int ~p:(conf_scheduler#plug "generic_queues") - ~d:2 "Generic queues" + ~d:5 "Generic queues" ~comments: [ "Number of event queues accepting any kind of task."; From d6afe4113fbbe0a64c3556a9c8105ff5665fdfe0 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 29 Sep 2024 20:49:06 -0500 Subject: [PATCH 028/151] Set thread names. (#4148) --- src/core/tools/tutils.ml | 1 + src/core/tools/unix_c.c | 56 +++++++++++++++++++++++++++------------- src/core/tools/utils.ml | 2 ++ 3 files changed, 41 insertions(+), 18 deletions(-) diff --git a/src/core/tools/tutils.ml b/src/core/tools/tutils.ml index c4f5e37caa..2257120b15 100644 --- a/src/core/tools/tutils.ml +++ b/src/core/tools/tutils.ml @@ -170,6 +170,7 @@ let create ~queue f x s = (fun () -> let id = let process x = + Utils.set_thread_name s; try f x; Mutex_utils.mutexify lock diff --git a/src/core/tools/unix_c.c b/src/core/tools/unix_c.c index 98c75fede6..f7ffd92704 100644 --- a/src/core/tools/unix_c.c +++ b/src/core/tools/unix_c.c @@ -1,29 +1,36 @@ +#ifdef WIN32 +#include +#include +#include +#else +#define _GNU_SOURCE + +#include +#include + +#ifdef __FreeBSD__ +#include +#endif +#endif + #include +#include #include #include #include -#include +#include #include -#include #include -#include -#include - -#ifdef WIN32 -#include #include -#else -#include -#endif +#include /* Some libraries mess with locale. In OCaml, locale should always * be "C", otherwise float_of_string and other functions do not behave * as expected. This issues arises in particular when using telnet * commands that need floats and when loading modules in bytecode mode.. */ -CAMLprim value liquidsoap_set_locale(value _locale) -{ +CAMLprim value liquidsoap_set_locale(value _locale) { CAMLparam1(_locale); - const char* locale = String_val(_locale); + const char *locale = String_val(_locale); #ifdef WIN32 char var[LOCALE_NAME_MAX_LENGTH]; @@ -32,11 +39,11 @@ CAMLprim value liquidsoap_set_locale(value _locale) snprintf(var, LOCALE_NAME_MAX_LENGTH, "LC_ALL=%s", locale); putenv(var); #else - setenv("LANG",locale,1); - setenv("LC_ALL",locale,1); + setenv("LANG", locale, 1); + setenv("LC_ALL", locale, 1); #endif /* This set the locale. */ - setlocale (LC_ALL, locale); + setlocale(LC_ALL, locale); CAMLreturn(Val_unit); } @@ -68,9 +75,11 @@ CAMLprim value liquidsoap_mktime(value _tm) { tm.tm_year = Int_val(Field(_tm, 5)); tm.tm_wday = 0; tm.tm_yday = 0; - tm.tm_isdst = Field(_tm, 6) == Val_int(0) ? -1 : Bool_val(Field(Field(_tm, 6), 0)); + tm.tm_isdst = + Field(_tm, 6) == Val_int(0) ? -1 : Bool_val(Field(Field(_tm, 6), 0)); time = mktime(&tm); - if (time == -1) unix_error(ERANGE, "mktime", Nothing); + if (time == -1) + unix_error(ERANGE, "mktime", Nothing); CAMLreturn(caml_copy_double((double)time)); } @@ -84,3 +93,14 @@ CAMLprim value liquidsoap_get_pagesize() { return Val_int(getpagesize()); #endif } + +CAMLprim value liquidsoap_set_thread_name(value _name) { +#ifdef WIN32 + SetThreadDescription(GetCurrentThreadId(), String_val(_name)); +#elif __APPLE__ + pthread_setname_np(String_val(_name)); +#else + pthread_setname_np(pthread_self(), String_val(_name)); +#endif + return Val_unit; +} diff --git a/src/core/tools/utils.ml b/src/core/tools/utils.ml index 1969ca2561..16074d5b9a 100644 --- a/src/core/tools/utils.ml +++ b/src/core/tools/utils.ml @@ -32,6 +32,8 @@ let log_exception ~(log : Log.t) ~bt msg = log#severe "%s" msg; if log#active 4 (* info *) then log#info "%s" bt +external set_thread_name : string -> unit = "liquidsoap_set_thread_name" + (* Force locale *) external force_locale : string -> unit = "liquidsoap_set_locale" From fb38672c02f0cf1113330fe6b112d8e591ee170a Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 30 Sep 2024 12:33:59 -0500 Subject: [PATCH 029/151] Cleanup thread name code. (#4150) --- src/core/tools/unix_c.c | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/src/core/tools/unix_c.c b/src/core/tools/unix_c.c index f7ffd92704..e3710b2f20 100644 --- a/src/core/tools/unix_c.c +++ b/src/core/tools/unix_c.c @@ -1,6 +1,5 @@ -#ifdef WIN32 +#ifdef _WIN32 #include -#include #include #else #define _GNU_SOURCE @@ -8,7 +7,7 @@ #include #include -#ifdef __FreeBSD__ +#if defined(__FreeBSD__) || defined(__OpenBSD__) #include #endif #endif @@ -17,6 +16,7 @@ #include #include #include +#include #include #include #include @@ -32,7 +32,7 @@ CAMLprim value liquidsoap_set_locale(value _locale) { CAMLparam1(_locale); const char *locale = String_val(_locale); -#ifdef WIN32 +#ifdef _WIN32 char var[LOCALE_NAME_MAX_LENGTH]; snprintf(var, LOCALE_NAME_MAX_LENGTH, "LANG=%s", locale); putenv(var); @@ -85,7 +85,7 @@ CAMLprim value liquidsoap_mktime(value _tm) { } CAMLprim value liquidsoap_get_pagesize() { -#ifdef WIN32 +#ifdef _WIN32 SYSTEM_INFO systemInfo; GetSystemInfo(&systemInfo); return Val_int(systemInfo.dwPageSize); @@ -95,10 +95,14 @@ CAMLprim value liquidsoap_get_pagesize() { } CAMLprim value liquidsoap_set_thread_name(value _name) { -#ifdef WIN32 - SetThreadDescription(GetCurrentThreadId(), String_val(_name)); -#elif __APPLE__ +#if defined(_WIN32) + char_os *thread_name = caml_stat_strdup_to_os(String_val(_name)); + SetThreadDescription(GetCurrentThread(), thread_name); + caml_stat_free(thread_name); +#elif defined(__APPLE__) pthread_setname_np(String_val(_name)); +#elif defined(__NetBSD__) + pthread_setname_np(pthread_self(), "%s", String_val(_name)); #else pthread_setname_np(pthread_self(), String_val(_name)); #endif From a25ebbe935162ba4e270ee695fdf3315f8fb0806 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 1 Oct 2024 10:45:09 -0500 Subject: [PATCH 030/151] Fix append operator. (#4152) --- src/libs/source.liq | 7 ++++--- tests/regression/append-merge.liq | 30 +++++++++++++++++++++++++++++ tests/regression/append.liq | 26 +++++++++++++++++++++++++ tests/regression/dune.inc | 32 +++++++++++++++++++++++++++++++ 4 files changed, 92 insertions(+), 3 deletions(-) create mode 100644 tests/regression/append-merge.liq create mode 100644 tests/regression/append.liq diff --git a/src/libs/source.liq b/src/libs/source.liq index 3e25138941..24526c93ea 100644 --- a/src/libs/source.liq +++ b/src/libs/source.liq @@ -194,18 +194,19 @@ def append(~id=null("append"), ~insert_missing=true, ~merge=false, s, f) = p = pending() pending := null() last_meta := null() + if null.defined(p) then p = null.get(p) sequence(merge=merge, [p, s]) else - s + null() end end - d = source.dynamic(track_sensitive=true, next) - s = fallback(id=id, track_sensitive=true, [d, s]) + d = source.dynamic(track_sensitive=false, next) + s = fallback(id=id, track_sensitive=false, [d, s]) s.{ pending= # Return the pending source diff --git a/tests/regression/append-merge.liq b/tests/regression/append-merge.liq new file mode 100644 index 0000000000..28065f995d --- /dev/null +++ b/tests/regression/append-merge.liq @@ -0,0 +1,30 @@ +music = chop(every=1., metadata=[("source", "s1")], sine(amplitude=0.1, 440.)) + +def next(_) = + s = sine(amplitude=0.1, duration=.5, 880.) + metadata.map(insert_missing=true, fun (_) -> [("source", "s2")], s) +end + +s = append(merge=true, music, next) + +count_s1 = ref(0) +count_s2 = ref(0) + +s.on_metadata( + fun (m) -> + begin + s = m["source"] + if + s == "s1" + then + ref.incr(count_s1) + elsif s == "s2" then ref.incr(count_s2) + end + + if count_s1() > 2 and count_s2() > 2 then test.pass() end + end +) + +s.on_track(fun (m) -> if m["source"] == "s2" then test.fail() end) + +output.dummy(s) diff --git a/tests/regression/append.liq b/tests/regression/append.liq new file mode 100644 index 0000000000..fc353283a2 --- /dev/null +++ b/tests/regression/append.liq @@ -0,0 +1,26 @@ +music = chop(every=1., metadata=[("source", "s1")], sine(amplitude=0.1, 440.)) + +def next(_) = + s = sine(amplitude=0.1, duration=.5, 880.) + metadata.map(insert_missing=true, fun (_) -> [("source", "s2")], s) +end + +s = append(music, next) + +count_s1 = ref(0) +count_s2 = ref(0) + +s.on_metadata(fun (m) -> begin + s = m["source"] + if s == "s1" then + ref.incr(count_s1) + elsif s == "s2" then + ref.incr(count_s2) + end + + if count_s1() > 2 and count_s2() > 2 then + test.pass() + end +end) + +output.dummy(s) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index 9d6ac8cab1..20f642d5aa 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -815,6 +815,38 @@ (:run_test ../run_test.exe)) (action (run %{run_test} LS503.liq liquidsoap %{test_liq} LS503.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + append-merge.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} append-merge.liq liquidsoap %{test_liq} append-merge.liq))) + +(rule + (alias citest) + (package liquidsoap) + (deps + append.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} append.liq liquidsoap %{test_liq} append.liq))) + (rule (alias citest) (package liquidsoap) From fcd8bf48818ad00c8da2c5222f6c6c97baf97eaa Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 2 Oct 2024 10:31:14 -0500 Subject: [PATCH 031/151] Add generic thread queues, use them to implement autocue-specific queue (#4151) --- CHANGES.md | 2 + doc/content/liq/radiopi.liq | 6 - doc/content/liq/task-example.liq | 5 + doc/content/liq/task-with-queue.liq | 12 + doc/content/migrating.md | 28 +++ doc/content/threads.md | 45 ++++ doc/dune.inc | 297 +++++++++++++++++++++++++ src/core/builtins/builtins_settings.ml | 27 ++- src/core/builtins/builtins_socket.ml | 6 +- src/core/builtins/builtins_thread.ml | 22 +- src/core/decoder/external_decoder.ml | 2 +- src/core/file_watcher.inotify.ml | 2 +- src/core/file_watcher.mtime.ml | 8 +- src/core/harbor/harbor.ml | 10 +- src/core/io/ffmpeg_io.ml | 2 +- src/core/io/srt_io.ml | 4 +- src/core/operators/pipe.ml | 2 +- src/core/outputs/harbor_output.ml | 8 +- src/core/sources/request_dynamic.ml | 18 +- src/core/tools/external_input.ml | 2 +- src/core/tools/liqfm.ml | 2 +- src/core/tools/server.ml | 2 +- src/core/tools/tutils.ml | 108 +++++---- src/core/tools/tutils.mli | 7 +- src/libs/autocue.liq | 24 +- src/libs/extra/deprecations.liq | 9 +- src/libs/extra/native.liq | 2 +- src/libs/extra/visualization.liq | 4 +- src/libs/playlist.liq | 14 +- src/libs/request.liq | 21 +- src/libs/thread.liq | 16 +- tests/language/error.liq | 2 +- 32 files changed, 582 insertions(+), 137 deletions(-) create mode 100644 doc/content/liq/task-example.liq create mode 100644 doc/content/liq/task-with-queue.liq create mode 100644 doc/content/threads.md diff --git a/CHANGES.md b/CHANGES.md index 881114a78a..f47b5730a1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -34,6 +34,8 @@ New: - Added `video.canvas` to make it possible to position video elements independently of the rendered video size ([#3656](https://github.com/savonet/liquidsoap/pull/3656), [blog post](https://www.liquidsoap.info/blog/2024-02-10-video-canvas-and-ai/)) - Added cover manager from an original code by @vitoyucepi (#3651) +- Reworked scheduler queues logic, allow user-defined queues, add options to pick + the queue to send asynchronous tasks to (#4151) - Added non-interleaved API to `%ffmpeg` encoder, enabled by default when only one stream is encoded. - Allow trailing commas in record definition (#3300). diff --git a/doc/content/liq/radiopi.liq b/doc/content/liq/radiopi.liq index 06553b29bd..9dd5e57b70 100644 --- a/doc/content/liq/radiopi.liq +++ b/doc/content/liq/radiopi.liq @@ -16,12 +16,6 @@ settings.harbor.bind_addrs.set(["0.0.0.0"]) # Verbose logs log.level.set(4) -# We use the scheduler intensively, -# therefore we create many queues. -settings.scheduler.generic_queues.set(5) -settings.scheduler.fast_queues.set(3) -settings.scheduler.non_blocking_queues.set(3) - # === Settings === # The host to request files diff --git a/doc/content/liq/task-example.liq b/doc/content/liq/task-example.liq new file mode 100644 index 0000000000..b667f0083d --- /dev/null +++ b/doc/content/liq/task-example.liq @@ -0,0 +1,5 @@ +def connect_callback() = + ignore(http.post("http://host/on_connect")) +end + +thread.run(connect_callback) diff --git a/doc/content/liq/task-with-queue.liq b/doc/content/liq/task-with-queue.liq new file mode 100644 index 0000000000..d07692d499 --- /dev/null +++ b/doc/content/liq/task-with-queue.liq @@ -0,0 +1,12 @@ +# Add 3 foo queue +settings.scheduler.queues.set([ + ...settings.scheduler.queues(), + ("foo", 3) +]) + +def connect_callback() = + ignore(http.post("http://host/on_connect")) +end + +# Execute inside the foo queue +thread.run(queue="foo", connect_callback) diff --git a/doc/content/migrating.md b/doc/content/migrating.md index 5ec412fbb0..6f6aca2361 100644 --- a/doc/content/migrating.md +++ b/doc/content/migrating.md @@ -76,6 +76,34 @@ def transition(old, new) = end ``` +### Thread queues + +In order to improve issues with complex inter-dependent asynchronous tasks such as `autocue` data computation, +scheduler queues have been improved. + +User-provided named queues can now be created and used to send asynchronous tasks, making it possible to control +concurrency of certain classes of tasks and also to remedy any potential dependency between asynchronous tasks. + +Settings for queues have thus changed and now will look like this: + +```liquidsoap +# Add a custom queue with 4 workers, increase generic queues to 4: +settings.scheduler.queues.set([ + ...list.assoc,remove("generic", settings.scheduler.queues()), + ("generic", 4), + ("custom", 4) +] +``` + +The `fast` argument of the `thread.run.*` functions has been replaced by `queue`, telling the operator which queue should the +asynchronous tasks sent to. + +Likewise, `request.dynamic`, `playlist`, `single` etc. have also been updated to accept a `thread_queue` argument controlling +which asynchronous queue their request resolution tasks should be sent to. + +See [the original Pull Request)[https://github.com/savonet/liquidsoap/pull/4151) and [the threads page](threads.html) +for more details. + ### Replaygain - There is a new `metadata.replaygain` function that extracts the replay gain value in _dB_ from the metadata. diff --git a/doc/content/threads.md b/doc/content/threads.md new file mode 100644 index 0000000000..c30fc25d7b --- /dev/null +++ b/doc/content/threads.md @@ -0,0 +1,45 @@ +# Threads + +The main purpose of liquidsoap is to create real time media streams. When streams are created, everything that +is needed to compute them needs to happen very quickly so that we make sure that the stream can in fact +be created in real time. + +When a tasks is required that may take some time and whose result is not required for the stream generation, +for instance when executing a `on_stop` or `on_connect` callback, it can be useful to execute this task in a _thread_. + +Threads in liquidsoap are callback functions that are executed by an asynchronous queue. Here's an example: + +```{.liquidsoap include="task-example.liq"} + +``` + +By default, there are two type of queues available in liquidsoap: + +- `generic` queues +- `non_blocking` queues + +By convention, tasks that are known to be executing very fast should be sent to the +`non_blockin` queues and all the other tasks should be sent to the `generic` queue. + +You can decide which queue to send tasks to by using the `queue` parameter of the +`thread.run` functions. Some other operators who also use threads can have a similar +parameter such as `thread_queue` for `request.dynamic` and `playlist`. + +```{.liquidsoap include="task-with-queue.liq"} + +``` + +You can also define your own named queue using the `settings.scheduler.queues` setting. +This is particularly useful for two applications: + +- To control concurrent execution of specific tasks. +- To prevent deadlocks in cases some tasks depends on other tasks. + +Typically, `autocue` data resolution is executed inside a `request` resolution. To +control the concurrency with which this CPU-intensive task is executed, we place them +in specific queues. The number of queues controls how many of these tasks can be executed +concurrently. + +Also, this prevents a deadlock where all the request resolution fill up the available +`generic` queues, making it impossible for the autocue computation to finish, thus preventing +the request resolution from returning. diff --git a/doc/dune.inc b/doc/dune.inc index 0f1f2fdff0..eab98186d9 100644 --- a/doc/dune.inc +++ b/doc/dune.inc @@ -167,6 +167,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -295,6 +297,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -423,6 +427,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -551,6 +557,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -679,6 +687,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -807,6 +817,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -935,6 +947,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1063,6 +1077,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1191,6 +1207,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1319,6 +1337,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1447,6 +1467,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1575,6 +1597,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1703,6 +1727,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1831,6 +1857,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1959,6 +1987,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2087,6 +2117,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2215,6 +2247,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2343,6 +2377,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2471,6 +2507,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2599,6 +2637,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2727,6 +2767,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2855,6 +2897,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2983,6 +3027,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3111,6 +3157,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3239,6 +3287,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3367,6 +3417,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3495,6 +3547,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3623,6 +3677,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3751,6 +3807,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3879,6 +3937,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4007,6 +4067,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4135,6 +4197,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4263,6 +4327,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4391,6 +4457,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4519,6 +4587,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4647,6 +4717,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4775,6 +4847,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4903,6 +4977,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5031,6 +5107,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5159,6 +5237,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5287,6 +5367,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5415,6 +5497,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5543,6 +5627,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5671,6 +5757,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5799,6 +5887,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5927,6 +6017,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6055,6 +6147,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6183,6 +6277,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6311,6 +6407,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6439,6 +6537,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6567,6 +6667,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6695,6 +6797,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6823,6 +6927,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6951,6 +7057,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7079,6 +7187,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7207,6 +7317,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7335,6 +7447,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7463,6 +7577,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7591,6 +7707,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7719,6 +7837,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7847,6 +7967,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7975,6 +8097,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8103,6 +8227,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8231,6 +8357,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8359,6 +8487,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8487,6 +8617,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8615,6 +8747,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8743,6 +8877,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8871,6 +9007,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8999,6 +9137,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -9025,6 +9165,136 @@ ) ) +(rule + (alias doc) + (package liquidsoap) + (enabled_if (not %{bin-available:pandoc})) + (deps (:no_pandoc no-pandoc)) + (target threads.html) + (action (run cp %{no_pandoc} %{target})) +) + +(rule + (alias doc) + (package liquidsoap) + (enabled_if %{bin-available:pandoc}) + (deps + liquidsoap.xml + language.dtd + template.html + content/liq/append-silence.liq + content/liq/archive-cleaner.liq + content/liq/basic-radio.liq + content/liq/beets-amplify.liq + content/liq/beets-protocol-short.liq + content/liq/beets-protocol.liq + content/liq/beets-source.liq + content/liq/blank-detect.liq + content/liq/blank-sorry.liq + content/liq/complete-case.liq + content/liq/cross.custom.liq + content/liq/crossfade.liq + content/liq/decoder-faad.liq + content/liq/decoder-flac.liq + content/liq/decoder-metaflac.liq + content/liq/dump-hourly.liq + content/liq/dump-hourly2.liq + content/liq/dynamic-source.liq + content/liq/external-output.file.liq + content/liq/fallback.liq + content/liq/ffmpeg-filter-dynamic-volume.liq + content/liq/ffmpeg-filter-flanger-highpass.liq + content/liq/ffmpeg-filter-hflip.liq + content/liq/ffmpeg-filter-hflip2.liq + content/liq/ffmpeg-filter-parallel-flanger-highpass.liq + content/liq/ffmpeg-live-switch.liq + content/liq/ffmpeg-relay-ondemand.liq + content/liq/ffmpeg-relay.liq + content/liq/ffmpeg-shared-encoding-rtmp.liq + content/liq/ffmpeg-shared-encoding.liq + content/liq/fixed-time1.liq + content/liq/fixed-time2.liq + content/liq/frame-size.liq + content/liq/harbor-auth.liq + content/liq/harbor-dynamic.liq + content/liq/harbor-insert-metadata.liq + content/liq/harbor-metadata.liq + content/liq/harbor-redirect.liq + content/liq/harbor-simple.liq + content/liq/harbor-usage.liq + content/liq/harbor.http.register.liq + content/liq/harbor.http.response.liq + content/liq/hls-metadata.liq + content/liq/hls-mp4.liq + content/liq/http-input.liq + content/liq/icy-update.liq + content/liq/input.mplayer.liq + content/liq/jingle-hour.liq + content/liq/json-ex.liq + content/liq/json-stringify.liq + content/liq/json1.liq + content/liq/live-switch.liq + content/liq/medialib-predicate.liq + content/liq/medialib.liq + content/liq/medialib.sqlite.liq + content/liq/multitrack-add-video-track.liq + content/liq/multitrack-add-video-track2.liq + content/liq/multitrack-default-video-track.liq + content/liq/multitrack.liq + content/liq/multitrack2.liq + content/liq/multitrack3.liq + content/liq/output.file.hls.liq + content/liq/playlists.liq + content/liq/prometheus-callback.liq + content/liq/prometheus-settings.liq + content/liq/radiopi.liq + content/liq/re-encode.liq + content/liq/regular.liq + content/liq/replaygain-metadata.liq + content/liq/replaygain-playlist.liq + content/liq/request.dynamic.liq + content/liq/rtmp.liq + content/liq/samplerate3.liq + content/liq/scheduling.liq + content/liq/seek-telnet.liq + content/liq/settings.liq + content/liq/shoutcast.liq + content/liq/single.liq + content/liq/source-cue.liq + content/liq/space_overhead.liq + content/liq/split-cue.liq + content/liq/sqlite.liq + content/liq/srt-receiver.liq + content/liq/srt-sender.liq + content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq + content/liq/transcoding.liq + content/liq/video-anonymizer.liq + content/liq/video-bluescreen.liq + content/liq/video-canvas-example.liq + content/liq/video-default-canvas.liq + content/liq/video-in-video.liq + content/liq/video-logo.liq + content/liq/video-osc.liq + content/liq/video-simple.liq + content/liq/video-static.liq + content/liq/video-text.liq + content/liq/video-transition.liq + content/liq/video-weather.liq + content/liq/video-webcam.liq + (:md content/threads.md) + ) + (target threads.html) + (action + (pipe-stdout + (run pandoc %{md} -t json) + (run pandoc-include --directory content/liq) + (run pandoc -f json --syntax-definition=liquidsoap.xml --highlight=pygments --metadata pagetitle=threads --template=template.html -o %{target}) + ) + ) +) + (rule (alias doc) (package liquidsoap) @@ -9127,6 +9397,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -9255,6 +9527,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -9383,6 +9657,8 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq + content/liq/task-example.liq + content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -10259,6 +10535,26 @@ (action (run %{bin:liquidsoap} --check --no-fallible-check content/liq/switch-show.liq)) ) +(rule + (alias doctest) + (package liquidsoap) + (deps + (source_tree ../src/libs) + (:test_liq content/liq/task-example.liq) + ) + (action (run %{bin:liquidsoap} --check --no-fallible-check content/liq/task-example.liq)) +) + +(rule + (alias doctest) + (package liquidsoap) + (deps + (source_tree ../src/libs) + (:test_liq content/liq/task-with-queue.liq) + ) + (action (run %{bin:liquidsoap} --check --no-fallible-check content/liq/task-with-queue.liq)) +) + (rule (alias doctest) (package liquidsoap) @@ -10494,6 +10790,7 @@ (stereotool.html as html/stereotool.html) (stream_content.html as html/stream_content.html) (strings_encoding.html as html/strings_encoding.html) + (threads.html as html/threads.html) (video-static.html as html/video-static.html) (video.html as html/video.html) (yaml.html as html/yaml.html) diff --git a/src/core/builtins/builtins_settings.ml b/src/core/builtins/builtins_settings.ml index db1a4e1d20..9ba65972d3 100644 --- a/src/core/builtins/builtins_settings.ml +++ b/src/core/builtins/builtins_settings.ml @@ -92,22 +92,32 @@ let settings_module = | ty, true -> Lang.fun_t [] ty | ty, false -> Lang.fun_t [] (Lang.nullable_t ty) in - let rec get_type ?(sub = []) conf = + let rec get_type ?(sub = []) ~label conf = let ty, has_default_value = get_conf_type conf in Lang.method_t (get_t ~has_default_value ty) - (set_t ty @ leaf_types conf @ sub) + (set_t ty @ leaf_types conf @ sub + @ + if label = "scheduler" then + [ + ( "queues", + ( [], + Lang.ref_t + (Lang.list_t (Lang.product_t Lang.string_t Lang.int_t)) ), + "Scheduler queue configuration." ); + ] + else []) and leaf_types conf = List.map (fun label -> - let ty = get_type (conf#path [label]) in + let ty = get_type ~label (conf#path [label]) in let label = Utils.normalize_parameter_string label in ( label, ([], ty), Printf.sprintf "Entry for configuration key %s" label )) conf#subs in - let settings_t = get_type Configure.conf in + let settings_t = get_type ~label:"settings" Configure.conf in let get_v fn conv_to conv_from conf = let get = Lang.val_fun [] (fun _ -> @@ -122,7 +132,7 @@ let settings_module = in (get, Some set) in - let rec get_value ?(sub = []) conf = + let rec get_value ?(sub = []) ~label conf = let to_v fn conv_to conv_from = try ignore (fn conf); @@ -144,7 +154,8 @@ let settings_module = with Found v -> v in Lang.meth get_v - ((if set_v <> None then [("set", Option.get set_v)] else []) + ((if label = "scheduler" then [("queues", Tutils.queues_conf)] else []) + @ (if set_v <> None then [("set", Option.get set_v)] else []) @ [ ("description", Lang.string (String.trim conf#descr)); ( "comments", @@ -154,11 +165,11 @@ let settings_module = and leaf_values conf = List.map (fun label -> - let v = get_value (conf#path [label]) in + let v = get_value ~label (conf#path [label]) in (Utils.normalize_parameter_string label, v)) conf#subs in - settings := get_value Configure.conf; + settings := get_value ~label:"settings" Configure.conf; ignore (Lang.add_builtin_value ~category:`Settings "settings" ~descr:"All settings." ~flags:[`Hidden] !settings settings_t)) diff --git a/src/core/builtins/builtins_socket.ml b/src/core/builtins/builtins_socket.ml index f001c4a8c6..4b278e8523 100644 --- a/src/core/builtins/builtins_socket.ml +++ b/src/core/builtins/builtins_socket.ml @@ -230,11 +230,7 @@ module Socket_value = struct [] in Duppy.Task.add Tutils.scheduler - { - Duppy.Task.priority = `Maybe_blocking; - events; - handler = fn; - }; + { Duppy.Task.priority = `Generic; events; handler = fn }; Lang.unit) ); ] in diff --git a/src/core/builtins/builtins_thread.ml b/src/core/builtins/builtins_thread.ml index d567c0f898..0866e9d3fc 100644 --- a/src/core/builtins/builtins_thread.ml +++ b/src/core/builtins/builtins_thread.ml @@ -40,16 +40,14 @@ let _ = let _ = Lang.add_builtin ~base:thread_run "recurrent" ~category:`Programming [ - ( "fast", - Lang.bool_t, - Some (Lang.bool true), + ( "queue", + Lang.string_t, + Some (Lang.string "generic"), Some - "Whether the thread is supposed to return quickly or not. Typically, \ - blocking tasks (e.g. fetching data over the internet) should not be \ - considered to be fast. When set to `false` its priority will be \ - lowered below that of request resolutions and fast timeouts. This \ - is only effective if you set a dedicated queue for fast tasks, see \ - the \"scheduler\" settings for more details." ); + "Queue to use for the task. Should be one of: `\"generic\"` or \ + `\"non_blocking\"`. Non blocking should be reserved for tasks that \ + are known to complete quickly. You can also use declared via \ + `settings.scheduler.queues`." ); ( "delay", Lang.float_t, Some (Lang.float 0.), @@ -74,8 +72,10 @@ let _ = let delay = Lang.to_float (List.assoc "delay" p) in let f = List.assoc "" p in let priority = - if Lang.to_bool (List.assoc "fast" p) then `Maybe_blocking - else `Blocking + match Lang.to_string (List.assoc "queue" p) with + | "generic" -> `Generic + | "non_blocking" -> `Non_blocking + | n -> `Named n in let on_error = Lang.to_option (List.assoc "on_error" p) in let on_error = diff --git a/src/core/decoder/external_decoder.ml b/src/core/decoder/external_decoder.ml index 2a60670808..efca33e872 100644 --- a/src/core/decoder/external_decoder.ml +++ b/src/core/decoder/external_decoder.ml @@ -49,7 +49,7 @@ let external_input process input = in let log s = log#important "%s" s in (* reading from input is blocking.. *) - let priority = `Blocking in + let priority = `Generic in let process = Process_handler.run ~priority ~on_stdin ~on_stderr ~log process in diff --git a/src/core/file_watcher.inotify.ml b/src/core/file_watcher.inotify.ml index 8ed0e8da5e..cf36f66de0 100644 --- a/src/core/file_watcher.inotify.ml +++ b/src/core/file_watcher.inotify.ml @@ -51,7 +51,7 @@ let rec watchdog () = events; [watchdog ()]) in - { Duppy.Task.priority = `Maybe_blocking; events = [`Read fd]; handler } + { Duppy.Task.priority = `Generic; events = [`Read fd]; handler } let watch : watch = fun ~pos e file f -> diff --git a/src/core/file_watcher.mtime.ml b/src/core/file_watcher.mtime.ml index 58a89af598..2df0c6ea9a 100644 --- a/src/core/file_watcher.mtime.ml +++ b/src/core/file_watcher.mtime.ml @@ -61,7 +61,7 @@ let rec handler _ = (Printf.sprintf "Error while executing file watcher callback: %s" (Printexc.to_string exn))) !watched; - [{ Duppy.Task.priority = `Maybe_blocking; events = [`Delay 1.]; handler }]) + [{ Duppy.Task.priority = `Generic; events = [`Delay 1.]; handler }]) () let watch : watch = @@ -73,11 +73,7 @@ let watch : watch = if not !launched then begin launched := true; Duppy.Task.add Tutils.scheduler - { - Duppy.Task.priority = `Maybe_blocking; - events = [`Delay 1.]; - handler; - } + { Duppy.Task.priority = `Generic; events = [`Delay 1.]; handler } end; let mtime = try file_mtime file with _ -> 0. in watched := { file; mtime; callback } :: !watched; diff --git a/src/core/harbor/harbor.ml b/src/core/harbor/harbor.ml index a2809de4a3..3c62adde0e 100644 --- a/src/core/harbor/harbor.ml +++ b/src/core/harbor/harbor.ml @@ -374,7 +374,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct simple_reply "No / mountpoint\r\n\r\n" in (* Authentication can be blocking. *) - Duppy.Monad.Io.exec ~priority:`Maybe_blocking h + Duppy.Monad.Io.exec ~priority:`Generic h (let user, auth_f = s#login in let user = if requested_user = "" then user else requested_user in if auth_f ~socket:h.Duppy.Monad.Io.socket user password then @@ -488,7 +488,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct Hashtbl.fold (fun lbl k query -> (lbl, k) :: query) query []) args in - Duppy.Monad.Io.exec ~priority:`Maybe_blocking h + Duppy.Monad.Io.exec ~priority:`Generic h (http_auth_check ?query ~login h.Duppy.Monad.Io.socket headers) (* We do not implement anything with this handler for now. *) @@ -631,7 +631,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct (Bytes.of_string (Websocket.upgrade headers)) in let* stype, huri, user, password = - Duppy.Monad.Io.exec ~priority:`Blocking h + Duppy.Monad.Io.exec ~priority:`Generic h (read_hello h.Duppy.Monad.Io.socket) in log#info "Mime type: %s" stype; @@ -899,7 +899,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct fun timeout -> fst (Http.read_chunked ~timeout socket) | _ -> fun _ -> "" in - Duppy.Monad.Io.exec ~priority:`Maybe_blocking h + Duppy.Monad.Io.exec ~priority:`Generic h (handler ~protocol ~meth ~headers ~data ~socket:h.Duppy.Monad.Io.socket ~query base_uri) | e -> @@ -969,7 +969,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct ~priority: (* ICY = true means that authentication has already happened *) - `Maybe_blocking h + `Generic h (let valid_user, auth_f = s#login in if not diff --git a/src/core/io/ffmpeg_io.ml b/src/core/io/ffmpeg_io.ml index 0be9875102..052690de3b 100644 --- a/src/core/io/ffmpeg_io.ml +++ b/src/core/io/ffmpeg_io.ml @@ -200,7 +200,7 @@ class input ?(name = "input.ffmpeg") ~autostart ~self_sync ~poll_delay ~debug | Some t -> Duppy.Async.wake_up t | None -> let t = - Duppy.Async.add ~priority:`Blocking Tutils.scheduler + Duppy.Async.add ~priority:`Generic Tutils.scheduler self#connect_task in Atomic.set connect_task (Some t); diff --git a/src/core/io/srt_io.ml b/src/core/io/srt_io.ml index fe177dafe8..f870441e6d 100644 --- a/src/core/io/srt_io.ml +++ b/src/core/io/srt_io.ml @@ -355,7 +355,7 @@ module Poll = struct (Printexc.to_string exn)); -1. - let task = Duppy.Async.add ~priority:`Blocking Tutils.scheduler process + let task = Duppy.Async.add ~priority:`Generic Tutils.scheduler process let add_socket ~mode socket fn = Srt.setsockflag socket Srt.sndsyn false; @@ -529,7 +529,7 @@ class virtual caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid | Some t -> Duppy.Async.wake_up t | None -> let t = - Duppy.Async.add ~priority:`Blocking Tutils.scheduler + Duppy.Async.add ~priority:`Generic Tutils.scheduler self#connect_fn in connect_task <- Some t; diff --git a/src/core/operators/pipe.ml b/src/core/operators/pipe.ml index 480ef0649b..d371255dba 100644 --- a/src/core/operators/pipe.ml +++ b/src/core/operators/pipe.ml @@ -254,7 +254,7 @@ class pipe ~replay_delay ~data_len ~process ~bufferize ~max ~restart Some (Process_handler.run ~on_stop:self#on_stop ~on_start:self#on_start ~on_stdout:self#on_stdout ~on_stdin:self#on_stdin - ~priority:`Blocking ~on_stderr:self#on_stderr ~log process)) + ~priority:`Generic ~on_stderr:self#on_stderr ~log process)) method! abort_track = source#abort_track diff --git a/src/core/outputs/harbor_output.ml b/src/core/outputs/harbor_output.ml index fab2ffca67..ff3534c27c 100644 --- a/src/core/outputs/harbor_output.ml +++ b/src/core/outputs/harbor_output.ml @@ -261,7 +261,7 @@ let add_meta c data = let rec client_task c = let* data = - Duppy.Monad.Io.exec ~priority:`Maybe_blocking c.handler + Duppy.Monad.Io.exec ~priority:`Generic c.handler (Mutex_utils.mutexify c.mutex (fun () -> let buflen = Strings.Mutable.length c.buffer in @@ -283,7 +283,7 @@ let rec client_task c = c.handler (Strings.to_bytes data) in let* state = - Duppy.Monad.Io.exec ~priority:`Maybe_blocking c.handler + Duppy.Monad.Io.exec ~priority:`Generic c.handler (let ret = Mutex_utils.mutexify c.mutex (fun () -> c.state) () in Duppy.Monad.return ret) in @@ -521,7 +521,7 @@ class output p = || auth_function <> None then ( let default_user = Option.value default_user ~default:"" in - Duppy.Monad.Io.exec ~priority:`Maybe_blocking handler + Duppy.Monad.Io.exec ~priority:`Generic handler (Harbor.http_auth_check ~query ~login:(default_user, login) s headers)) else Duppy.Monad.return ()) @@ -532,7 +532,7 @@ class output p = Harbor.reply s | _ -> assert false) in - Duppy.Monad.Io.exec ~priority:`Maybe_blocking handler + Duppy.Monad.Io.exec ~priority:`Generic handler (Harbor.relayed reply (fun () -> self#log#info "Client %s connected" ip; Mutex_utils.mutexify clients_m diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml index 4408f94b98..7dddd79245 100644 --- a/src/core/sources/request_dynamic.ml +++ b/src/core/sources/request_dynamic.ml @@ -26,9 +26,6 @@ module Queue = Liquidsoap_lang.Queues.Queue let conf_prefetch = Dtools.Conf.int ~p:(Request.conf#plug "prefetch") ~d:1 "Default prefetch" -(* Scheduler priority for request resolutions. *) -let priority = `Maybe_blocking - type queue_item = { request : Request.t; (* in seconds *) @@ -62,7 +59,8 @@ let () = Lifecycle.before_core_shutdown ~name:"request.dynamic shutdown" (fun () -> Atomic.set should_fail true) -class dynamic ~retry_delay ~available (f : Lang.value) prefetch timeout = +class dynamic ~priority ~retry_delay ~available (f : Lang.value) prefetch + timeout = let available () = (not (Atomic.get should_fail)) && available () in object (self) inherit source ~name:"request.dynamic" () @@ -340,6 +338,10 @@ let _ = ~descr:"Play request dynamically created by a given function." [ ("", Lang.fun_t [] (Lang.nullable_t Request.Value.t), None, None); + ( "thread_queue", + Lang.string_t, + Some (Lang.string "generic"), + Some "Queue used to resolve requests." ); ( "retry_delay", Lang.getter_t Lang.float_t, Some (Lang.float 0.1), @@ -429,5 +431,11 @@ let _ = let f = List.assoc "" p in let available = Lang.to_bool_getter (List.assoc "available" p) in let retry_delay = Lang.to_float_getter (List.assoc "retry_delay" p) in + let priority = + match Lang.to_string (List.assoc "thread_queue" p) with + | "generic" -> `Generic + | "non_blocking" -> `Non_blocking + | n -> `Named n + in let l, t = extract_queued_params p in - new dynamic ~available ~retry_delay f l t) + new dynamic ~available ~priority ~retry_delay f l t) diff --git a/src/core/tools/external_input.ml b/src/core/tools/external_input.ml index 4df1a70239..e4a6c155bb 100644 --- a/src/core/tools/external_input.ml +++ b/src/core/tools/external_input.ml @@ -67,7 +67,7 @@ class virtual base ~name ~restart ~restart_on_error ~on_data ?read_header let log s = self#log#important "%s" s in process <- Some - (Process_handler.run ~priority:`Blocking ~on_stop ~on_stdout + (Process_handler.run ~priority:`Generic ~on_stop ~on_stdout ~on_stderr ~log (command ()))); self#on_sleep (fun () -> diff --git a/src/core/tools/liqfm.ml b/src/core/tools/liqfm.ml index d4c0eeddad..8882fb1b3b 100644 --- a/src/core/tools/liqfm.ml +++ b/src/core/tools/liqfm.ml @@ -231,7 +231,7 @@ let init host = reason (Printexc.to_string e); -1. in - let task = Duppy.Async.add ~priority:`Blocking Tutils.scheduler do_submit in + let task = Duppy.Async.add ~priority:`Generic Tutils.scheduler do_submit in { task; submit_m; submissions } let submit (user, password) task length source stype songs = diff --git a/src/core/tools/server.ml b/src/core/tools/server.ml index c0d495830f..bcb19e0386 100644 --- a/src/core/tools/server.ml +++ b/src/core/tools/server.ml @@ -317,7 +317,7 @@ let handle_client socket ip = | e -> Duppy.Monad.raise e in let* ans = - Duppy.Monad.Io.exec ~priority:`Maybe_blocking h (run (fun () -> exec req)) + Duppy.Monad.Io.exec ~priority:`Generic h (run (fun () -> exec req)) in let* () = let* () = diff --git a/src/core/tools/tutils.ml b/src/core/tools/tutils.ml index 2257120b15..cef2b88e49 100644 --- a/src/core/tools/tutils.ml +++ b/src/core/tools/tutils.ml @@ -20,6 +20,9 @@ *****************************************************************************) +module Methods = Liquidsoap_lang.Methods +module Lang = Liquidsoap_lang.Lang + let conf_scheduler = Dtools.Conf.void ~p:(Configure.conf#plug "scheduler") @@ -68,43 +71,6 @@ let exit () = | `Done (`Error (bt, err)) -> Printexc.raise_with_backtrace err bt | _ -> exit (exit_code ()) -let generic_queues = - Dtools.Conf.int - ~p:(conf_scheduler#plug "generic_queues") - ~d:5 "Generic queues" - ~comments: - [ - "Number of event queues accepting any kind of task."; - "There should at least be one. Having more can be useful to make sure"; - "that trivial request resolutions (local files) are not delayed"; - "because of a stalled download. But N stalled download can block"; - "N queues anyway."; - ] - -let fast_queues = - Dtools.Conf.int - ~p:(conf_scheduler#plug "fast_queues") - ~d:0 "Fast queues" - ~comments: - [ - "Number of queues that are dedicated to fast tasks."; - "It might be useful to create some if your request resolutions,"; - "or some user defined tasks (cf `thread.run`), are"; - "delayed too much because of slow tasks blocking the generic queues,"; - "such as last.fm submissions or slow `thread.run` handlers."; - ] - -let non_blocking_queues = - Dtools.Conf.int - ~p:(conf_scheduler#plug "non_blocking_queues") - ~d:2 "Non-blocking queues" - ~comments: - [ - "Number of queues dedicated to internal non-blocking tasks."; - "These are only started if such tasks are needed."; - "There should be at least one."; - ] - let scheduler_log = Dtools.Conf.bool ~p:(conf_scheduler#plug "log") @@ -133,6 +99,26 @@ end) let all = ref Set.empty let queues = ref Set.empty +let queues_conf_ref = Atomic.make [("generic", 2); ("non_blocking", 2)] + +let queues_conf = + Lang.reference + (fun () -> + let v = Atomic.get queues_conf_ref in + Lang.list + (List.map + (fun (lbl, c) -> Lang.product (Lang.string lbl) (Lang.int c)) + v)) + (fun v -> + let v = Lang.to_list v in + let v = + List.map + (fun v -> + let lbl, c = Lang.to_product v in + (Lang.to_string lbl, Lang.to_int c)) + v + in + Atomic.set queues_conf_ref v) let join_all ~set () = let rec f () = @@ -226,8 +212,8 @@ let create ~queue f x s = () type priority = - [ `Blocking (** For example a last.fm submission. *) - | `Maybe_blocking (** Request resolutions vary a lot. *) + [ `Generic (** Generic queues accept all tasks. *) + | `Named of string (** Named queues only accept tasks with their priority. *) | `Non_blocking (** Non-blocking tasks like the server. *) ] let error_handlers = Stack.create () @@ -266,13 +252,14 @@ let scheduler_log n = fun m -> log#info "%s" m) else fun _ -> () -let new_queue ?priorities ~name () = +let new_queue ~priority ~name () = let qlog = scheduler_log name in - let queue () = - match priorities with - | None -> Duppy.queue scheduler ~log:qlog name - | Some priorities -> Duppy.queue scheduler ~log:qlog ~priorities name + let priorities p = + match (priority, p) with + | `Generic, (`Generic | `Non_blocking) -> true + | v, v' -> v = v' in + let queue () = Duppy.queue scheduler ~log:qlog ~priorities name in ignore (create ~queue:true queue () name) let create f x name = create ~queue:false f x name @@ -280,18 +267,27 @@ let join_all () = join_all ~set:all () let start () = if Atomic.compare_and_set state `Idle `Starting then ( - for i = 1 to generic_queues#get do - let name = Printf.sprintf "generic queue #%d" i in - new_queue ~name () - done; - for i = 1 to fast_queues#get do - let name = Printf.sprintf "fast queue #%d" i in - new_queue ~name ~priorities:(fun x -> x = `Maybe_blocking) () - done; - for i = 1 to non_blocking_queues#get do - let name = Printf.sprintf "non-blocking queue #%d" i in - new_queue ~priorities:(fun x -> x = `Non_blocking) ~name () - done) + let queues = Methods.from_list (Atomic.get queues_conf_ref) in + Methods.iter + (fun priority count -> + let priority = + match priority with + | "generic" -> `Generic + | "non_blocking" -> `Non_blocking + | n -> `Named n + in + for i = 1 to count do + let name = + Printf.sprintf "%s queue #%d" + (match priority with + | `Generic -> "generic" + | `Named n -> n + | `Non_blocking -> "non-blocking") + i + in + new_queue ~priority ~name () + done) + queues) (** Waits for [f()] to become true on condition [c]. *) let wait c m f = diff --git a/src/core/tools/tutils.mli b/src/core/tools/tutils.mli index c9d91f9e49..2059b28777 100644 --- a/src/core/tools/tutils.mli +++ b/src/core/tools/tutils.mli @@ -55,10 +55,13 @@ val join_all : unit -> unit (** Priorities for the different scheduler usages. *) type priority = - [ `Blocking (** For example a last.fm submission. *) - | `Maybe_blocking (** Request resolutions vary a lot. *) + [ `Generic (** Generic queues accept all tasks. *) + | `Named of string (** Named queues only accept tasks with their priority. *) | `Non_blocking (** Non-blocking tasks like the server. *) ] +(** Queues configuration. *) +val queues_conf : Liquidsoap_lang.Lang.value + (** task scheduler *) val scheduler : priority Duppy.scheduler diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index 52beda3bc1..c5738937ee 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -58,6 +58,25 @@ let settings.autocue.internal.metadata_override = ] ) +let settings.autocue.internal.queues_count = + settings.make( + description= + "Number of dedicated queues for resolving autocue data using the internal \ + implementation", + 1 + ) + +def settings.autocue.internal.queues_count.set(c) = + settings.scheduler.queues := + [ + ...list.assoc.remove("autocue", settings.scheduler.queues()), + ("autocue", c) + ] + settings.autocue.internal.queues_count.set(c) +end + +settings.autocue.internal.queues_count.set(1) + let settings.autocue.internal.lufs_target = settings.make( description= @@ -187,7 +206,10 @@ def autocue.internal.ebur128(~ratio=50., ~timeout=10., filename) = ) [] else - s = request.once(request.create(resolve_metadata=false, filename)) + s = + request.once( + thread_queue="autocue", request.create(resolve_metadata=false, filename) + ) frames = ref([]) def ebur128(s) = diff --git a/src/libs/extra/deprecations.liq b/src/libs/extra/deprecations.liq index 9ac8638b4d..5337a4555c 100644 --- a/src/libs/extra/deprecations.liq +++ b/src/libs/extra/deprecations.liq @@ -76,9 +76,10 @@ end # Deprecated: this function has been replaced by `thread.run.recurrent`. # @flag deprecated -def add_timeout(~fast=true, delay, f) = +def add_timeout(~fast, delay, f) = deprecated("add_timeout", "thread.run.recurrent") - thread.run.recurrent(fast=fast, delay=delay, f) + ignore(fast or true) + thread.run.recurrent(queue="generic", delay=delay, f) end # Deprecated: this function has been replaced by `thread.when`. @@ -314,7 +315,7 @@ def register_flow( ping_period end - thread.run.recurrent(fast=false, delay=ping_period, ping) + thread.run.recurrent(delay=ping_period, ping) # Register streams def register_stream(format_url) = @@ -339,7 +340,7 @@ def register_flow( artist = m["artist"] title = m["title"] params = [("m_title", title), ("m_artist", artist)] - thread.run(fast=false, {request(cmd="metadata", params=params)}) + thread.run({request(cmd="metadata", params=params)}) end s.on_metadata(metadata) diff --git a/src/libs/extra/native.liq b/src/libs/extra/native.liq index 3f7b1f359b..4cfdfa5f86 100644 --- a/src/libs/extra/native.liq +++ b/src/libs/extra/native.liq @@ -170,7 +170,7 @@ def native.request.dynamic(%argsof(request.dynamic), f) = if list.length(queue()) < prefetch then ignore(fetch()) end end - thread.run(every=retry_delay, fill) + thread.run(queue=thread_queue, every=retry_delay, fill) # Source def s() = diff --git a/src/libs/extra/visualization.liq b/src/libs/extra/visualization.liq index 20a662ca9b..93b441e8d1 100644 --- a/src/libs/extra/visualization.liq +++ b/src/libs/extra/visualization.liq @@ -28,7 +28,7 @@ def vumeter(~rms_min=-25., ~rms_max=-5., ~window=0.5, ~scroll=false, s) = print(newline=false, bar()) end - thread.run(fast=true, every=window, display) + thread.run(queue="non_blocking", every=window, display) s end @@ -62,7 +62,7 @@ def video.vumeter( width := int_of_float(x * float_of_int(video.frame.width())) end - thread.run(fast=true, every=window, update) + thread.run(queue="non_blocking", every=window, update) s = video.add_rectangle(width=width, height=height, color=color, s) video.persistence(duration=persistence, s) end diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq index 2a011104cb..2117b7ed90 100644 --- a/src/libs/playlist.liq +++ b/src/libs/playlist.liq @@ -185,6 +185,7 @@ let stdlib_native = native # whole round ("randomize" mode), or pick a random file in the playlist each time \ # ("random" mode). # @param ~native Use native implementation, when available. +# @param ~thread_queue Queue used to resolve requests. # @param ~on_loop Function executed when the playlist is about to loop. # @param ~on_done Function executed when the playlist is finished. # @param ~max_fail When this number of requests fail to resolve, the whole playlists is considered as failed and `on_fail` is called. @@ -197,6 +198,7 @@ let stdlib_native = native # @method remaining_files Songs remaining to be played. def playlist.list( ~id=null(), + ~thread_queue="generic", ~check_next=null(), ~prefetch=null(), ~loop=true, @@ -263,6 +265,7 @@ def playlist.list( fun () -> request.dynamic( id=id, + thread_queue=thread_queue, prefetch=prefetch, timeout=timeout, retry_delay=1., @@ -272,7 +275,13 @@ def playlist.list( s = %ifdef native - if native then stdlib_native.request.dynamic(id=id, next) else default() end + if + native + then + stdlib_native.request.dynamic(id=id, thread_queue=thread_queue, next) + else + default() + end %else default() %endif @@ -455,6 +464,7 @@ end # the playlist), "rounds", "seconds" or "watch" (reload the file whenever it is \ # changed). # @param ~timeout Timeout (in sec.) for a single download. +# @param ~thread_queue Queue used to resolve requests. # @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. # @param ~cue_out_metadata Metadata for cue out points. Disabled if `null`. # @param uri Playlist URI. @@ -463,6 +473,7 @@ end # @method remaining_files Songs remaining to be played. def replaces playlist( ~id=null(), + ~thread_queue="generic", ~check_next=null(), ~prefetch=null(), ~loop=true, @@ -582,6 +593,7 @@ def replaces playlist( s = playlist.list( id=id, + thread_queue=thread_queue, check_next=check_next, prefetch=prefetch, loop=loop, diff --git a/src/libs/request.liq b/src/libs/request.liq index fc006dfbf7..511d312b5b 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -27,6 +27,7 @@ end # @param ~prefetch How many requests should be queued in advance. # @param ~native Use native implementation, when available. # @param ~queue Initial queue of requests. +# @param ~thread_queue Queue used to resolve requests. # @param ~timeout Timeout (in sec.) for a single download. # @method add This method is internal and should not be used. Consider using `push` instead. # @method push Push a request on the request queue. @@ -37,6 +38,7 @@ def request.queue( ~prefetch=null(), ~native=false, ~queue=[], + ~thread_queue="generic", ~timeout=20. ) = ignore(native) @@ -77,6 +79,7 @@ def request.queue( request.dynamic( id=id, prefetch=prefetch, + thread_queue=thread_queue, timeout=timeout, available={not list.is_empty(queue())}, next @@ -87,7 +90,9 @@ def request.queue( if native then - stdlib_native.request.dynamic(id=id, timeout=timeout, next) + stdlib_native.request.dynamic( + id=id, thread_queue=thread_queue, timeout=timeout, next + ) else default() end @@ -204,9 +209,15 @@ end # Play a request once and become unavailable. # @category Source / Input +# @param ~thread_queue Queue used to resolve requests. # @param ~timeout Timeout in seconds for resolving the request. # @param r Request to play. -def request.once(~id=null("request.once"), ~timeout=20., r) = +def request.once( + ~id=null("request.once"), + ~thread_queue="generic", + ~timeout=20., + r +) = id = string.id.default(default="request.once", id) done = ref(false) @@ -222,7 +233,7 @@ def request.once(~id=null("request.once"), ~timeout=20., r) = if request.resolve(r, timeout=timeout) then - request.queue(queue=[r]) + request.queue(thread_queue=thread_queue, queue=[r]) else log.critical( label=id, @@ -246,6 +257,7 @@ end # static, and time is not. # @category Source / Input # @param ~prefetch How many requests should be queued in advance. +# @param ~thread_queue Queue used to resolve requests. # @param ~timeout Timeout (in sec.) for a single download. # @param ~fallible Enforce fallibility of the request. # @param r Request @@ -253,6 +265,7 @@ def request.single( ~id=null("request.single"), ~prefetch=null(), ~timeout=20., + ~thread_queue="generic", ~fallible=null(), r ) = @@ -329,7 +342,7 @@ def request.single( static_request() ?? getter.get(r) end - s = request.dynamic(prefetch=prefetch, next) + s = request.dynamic(prefetch=prefetch, thread_queue=thread_queue, next) if infallible then s.set_queue([next()]) end s end diff --git a/src/libs/thread.liq b/src/libs/thread.liq index d623577108..45c4dbe699 100644 --- a/src/libs/thread.liq +++ b/src/libs/thread.liq @@ -1,13 +1,15 @@ # Run a function in a separate thread. # @category Programming -# @param ~fast Whether the thread is supposed to return quickly or not. Typically, blocking tasks (e.g. fetching data over the internet) should not be considered to be fast. When set to `false` its priority will be lowered below that of request resolutions and fast timeouts. This is only effective if you set a dedicated queue for fast tasks, see the "scheduler" settings for more details. +# @param ~queue Queue to use for the task. Should be one of: `"generic"` or `"non_blocking"`. \ +# Non blocking should be reserved for tasks that are known to complete quickly. \ +# You can also use a dedicated queue name declared via `settings.scheduler.queues`. # @param ~delay Delay (in seconds) after which the thread should be launched. # @param ~every How often (in seconds) the thread should be run. If negative or `null`, run once. # @param ~on_error Error callback executed when an error occurred while running the given function. When passed, \ # all raised errors are silenced unless re-raised by the callback. # @param f Function to execute. def replaces thread.run( - ~fast=true, + ~queue="generic", ~delay=0., ~on_error=null(), ~every=null(), @@ -31,7 +33,7 @@ def replaces thread.run( on_error ) - thread.run.recurrent(fast=fast, delay=delay, on_error=on_error, f) + thread.run.recurrent(queue=queue, delay=delay, on_error=on_error, f) end # Execute a callback when a predicate is `true`. The predicate @@ -39,7 +41,9 @@ end # called when the predicate returns `true` after having been # `false`, following the same semantics as `predicate.activates`. # @category Programming -# @param ~fast Whether the callback is supposed to return quickly or not. +# @param ~queue Queue to use for the task. Should be one of: `"generic"` or `"non_blocking"`. \ +# Non blocking should be reserved for tasks that are known to complete quickly. \ +# You can also use a dedicated queue name declared via `settings.scheduler.queues`. # @param ~init Detect at beginning. # @param ~every How often (in sec.) to check for the predicate. # @param ~once Execute the function only once. @@ -49,7 +53,7 @@ end # @param p Predicate indicating when to execute the function, typically a time interval such as `{10h-10h30}`. # @param f Function to execute when the predicate is true. def thread.when( - ~fast=true, + ~queue="generic", ~init=true, ~every=getter(0.5), ~once=false, @@ -71,7 +75,7 @@ def thread.when( end end - thread.run.recurrent(fast=fast, delay=0., on_error=on_error, check) + thread.run.recurrent(queue=queue, delay=0., on_error=on_error, check) end # @flag hidden diff --git a/tests/language/error.liq b/tests/language/error.liq index 76e177412e..67b11c3c51 100644 --- a/tests/language/error.liq +++ b/tests/language/error.liq @@ -70,7 +70,7 @@ def f() = ) test.equal(r/error.liq, line 58 char 4 - line 63 char 7/.test(pos), true) - test.equal(r/thread.liq, line 19, char 11-14/.test(pos), true) + test.equal(r/thread.liq, line 21, char 11-14/.test(pos), true) e' = error.register("bla") test.equal(false, (e == e')) From c117033da52c22a4b9f890e11a708a1ff629a377 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 2 Oct 2024 13:49:36 -0500 Subject: [PATCH 032/151] Update threads.md --- doc/content/threads.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/content/threads.md b/doc/content/threads.md index c30fc25d7b..cee2eaab21 100644 --- a/doc/content/threads.md +++ b/doc/content/threads.md @@ -4,7 +4,7 @@ The main purpose of liquidsoap is to create real time media streams. When stream is needed to compute them needs to happen very quickly so that we make sure that the stream can in fact be created in real time. -When a tasks is required that may take some time and whose result is not required for the stream generation, +When a task is required that may take some time and whose result is not required for the stream generation, for instance when executing a `on_stop` or `on_connect` callback, it can be useful to execute this task in a _thread_. Threads in liquidsoap are callback functions that are executed by an asynchronous queue. Here's an example: @@ -25,19 +25,19 @@ You can decide which queue to send tasks to by using the `queue` parameter of th `thread.run` functions. Some other operators who also use threads can have a similar parameter such as `thread_queue` for `request.dynamic` and `playlist`. -```{.liquidsoap include="task-with-queue.liq"} +You can also define your own named queue using the `settings.scheduler.queues` setting. +```{.liquidsoap include="task-with-queue.liq"} ``` -You can also define your own named queue using the `settings.scheduler.queues` setting. This is particularly useful for two applications: - To control concurrent execution of specific tasks. -- To prevent deadlocks in cases some tasks depends on other tasks. +- To prevent deadlocks in case some tasks depends on other tasks. Typically, `autocue` data resolution is executed inside a `request` resolution. To control the concurrency with which this CPU-intensive task is executed, we place them -in specific queues. The number of queues controls how many of these tasks can be executed +in a specific queue. The number of queues controls how many of these tasks can be executed concurrently. Also, this prevents a deadlock where all the request resolution fill up the available From e861a85559827ef698156577bb77349cfa820ac3 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 2 Oct 2024 14:14:10 -0500 Subject: [PATCH 033/151] Fix formatting. --- doc/content/threads.md | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/content/threads.md b/doc/content/threads.md index cee2eaab21..68d07cb990 100644 --- a/doc/content/threads.md +++ b/doc/content/threads.md @@ -28,6 +28,7 @@ parameter such as `thread_queue` for `request.dynamic` and `playlist`. You can also define your own named queue using the `settings.scheduler.queues` setting. ```{.liquidsoap include="task-with-queue.liq"} + ``` This is particularly useful for two applications: From e90d5b5c1500fc92dc55111f9f1e7ce371c2898b Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 3 Oct 2024 08:39:41 -0500 Subject: [PATCH 034/151] Add method to return the sequence's current queue. --- src/core/operators/sequence.ml | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/core/operators/sequence.ml b/src/core/operators/sequence.ml index a4b056f820..796840c141 100644 --- a/src/core/operators/sequence.ml +++ b/src/core/operators/sequence.ml @@ -48,17 +48,17 @@ class sequence ?(merge = false) ?(single_track = true) sources = (* We have to wait until at least one source is ready. *) val mutable has_started = false + method queue = Atomic.get seq_sources method private has_started = match has_started with | true -> true | false -> - has_started <- - List.exists (fun s -> s#is_ready) (Atomic.get seq_sources); + has_started <- List.exists (fun s -> s#is_ready) self#queue; has_started method private get_source ~reselect () = - match (self#has_started, Atomic.get seq_sources) with + match (self#has_started, self#queue) with | _, [] -> None | true, s :: [] -> if @@ -85,21 +85,20 @@ class sequence ?(merge = false) ?(single_track = true) sources = method remaining = if merge then ( let ( + ) a b = if a < 0 || b < 0 then -1 else a + b in - List.fold_left ( + ) 0 - (List.map (fun s -> s#remaining) (Atomic.get seq_sources))) - else (List.hd (Atomic.get seq_sources))#remaining + List.fold_left ( + ) 0 (List.map (fun s -> s#remaining) self#queue)) + else (List.hd self#queue)#remaining method seek_source = - match Atomic.get seq_sources with + match self#queue with | s :: _ -> s#seek_source | _ -> (self :> Source.source) method abort_track = if merge then ( - match List.rev (Atomic.get seq_sources) with + match List.rev self#queue with | [] -> assert false | hd :: _ -> Atomic.set seq_sources [hd]); - match Atomic.get seq_sources with hd :: _ -> hd#abort_track | _ -> () + match self#queue with hd :: _ -> hd#abort_track | _ -> () end class merge_tracks source = @@ -143,6 +142,15 @@ let _ = "Play a sequence of sources. By default, play one track per source, \ except for the last one which is played as much as available." ~return_t:frame_t + ~meth: + [ + ( "queue", + ([], Lang.fun_t [] (Lang.list_t (Lang.source_t frame_t))), + "Return the current sequence of source", + fun s -> + Lang.val_fun [] (fun _ -> Lang.list (List.map Lang.source s#queue)) + ); + ] (fun p -> new sequence ~merge:(Lang.to_bool (List.assoc "merge" p)) From 2e0f2a1e494eabe8eef02d48eaba095368a08562 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 3 Oct 2024 08:40:46 -0500 Subject: [PATCH 035/151] Log. --- src/core/sources/request_dynamic.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml index 7dddd79245..5c50398756 100644 --- a/src/core/sources/request_dynamic.ml +++ b/src/core/sources/request_dynamic.ml @@ -308,7 +308,7 @@ class dynamic ~priority ~retry_delay ~available (f : Lang.value) prefetch (fun r -> Queue.push retrieved r) (remove_expired []); Queue.push retrieved { request = req; expired = false }; - self#log#info "Queued %d requests" self#queue_size; + self#log#info "Queued %d request(s)" self#queue_size; `Finished | _ -> Request.destroy req; From 1dc6faca0e2544f89bfdb216558aab0c1be783f8 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 4 Oct 2024 08:00:33 -0500 Subject: [PATCH 036/151] Cleanup source.dynamic, fix `append` (#4156) --- CHANGES.md | 3 + src/core/builtins/builtins_source.ml | 9 ++ src/core/operators/dyn_op.ml | 131 ++++++++++++++------------- src/libs/extra/source.liq | 4 +- src/libs/request.liq | 54 ++++++++--- src/libs/source.liq | 49 +++++----- src/libs/video.liq | 79 ++++++++++------ 7 files changed, 197 insertions(+), 132 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index f47b5730a1..3fe09d0f5c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -62,6 +62,9 @@ New: Changed: +- Reimplemented `request.once`, `single` and more using `source.dynamic`. Removed experiment + flag on `source.dynamic`. The operator is considered stable enough to define advanced sources + but the user should be careful when using it. - Mute SDL startup messages (#2913). - `int` can optionally raises an error when passing `nan` or `infinity`, `int(infinity)` now returns `max_int` and `int(-infinity)` returns `min_int`. (#3407) diff --git a/src/core/builtins/builtins_source.ml b/src/core/builtins/builtins_source.ml index 1497693389..4bd5ad1f18 100644 --- a/src/core/builtins/builtins_source.ml +++ b/src/core/builtins/builtins_source.ml @@ -41,6 +41,15 @@ let _ = s#set_name n; Lang.unit) +let _ = + Lang.add_builtin ~base:source "last_metadata" ~category:(`Source `Liquidsoap) + ~descr:"Return the last metadata from the source." + [("", Lang.source_t (Lang.univ_t ()), None, None)] + (Lang.nullable_t Lang.metadata_t) + (fun p -> + let s = Lang.to_source (List.assoc "" p) in + match s#last_metadata with None -> Lang.null | Some m -> Lang.metadata m) + let _ = Lang.add_builtin ~base:source "skip" ~category:(`Source `Liquidsoap) ~descr:"Skip to the next track." diff --git a/src/core/operators/dyn_op.ml b/src/core/operators/dyn_op.ml index 426f65f874..01c60d48ac 100644 --- a/src/core/operators/dyn_op.ml +++ b/src/core/operators/dyn_op.ml @@ -20,84 +20,85 @@ *****************************************************************************) -class dyn ~init ~track_sensitive ~infallible ~resurection_time ~self_sync f = +class dyn ~init ~track_sensitive ~infallible ~self_sync ~merge next_fn = object (self) inherit Source.source ~name:"source.dynamic" () - - inherit - Source.generate_from_multiple_sources - ~merge:(fun () -> false) - ~track_sensitive () - + inherit Source.generate_from_multiple_sources ~merge ~track_sensitive () method fallible = not infallible val mutable activation = [] - val source : Source.source option Atomic.t = Atomic.make init + val current_source : Source.source option Atomic.t = Atomic.make init + method current_source = Atomic.get current_source val mutable last_select = Unix.gettimeofday () - val proposed = Atomic.make None - method propose s = Atomic.set proposed (Some s) - method private prepare s = + method private no_source = + if infallible then + Lang.raise_error ~pos:[] + ~message: + (Printf.sprintf + "Infallible source.dynamic %s was not able to prepare a source \ + in time! Make sure to either define infallible sources in the \ + source's dynamic function or mark the source as fallible.." + self#id) + "failure"; + None + + method prepare s = Typing.(s#frame_type <: self#frame_type); Clock.unify ~pos:self#pos s#clock self#clock; - s#wake_up; - (match Atomic.exchange source (Some s) with - | Some s -> s#sleep - | None -> ()); - if s#is_ready then Some s else None + s#wake_up + + method private exchange s = + self#log#info "Switching to source %s" s#id; + self#prepare s; + Atomic.set current_source (Some s); + if s#is_ready then Some s else self#no_source method private get_next reselect = self#mutexify (fun () -> - match Atomic.exchange proposed None with - | Some s -> self#prepare s + last_select <- Unix.gettimeofday (); + let s = + Lang.apply next_fn [] |> Lang.to_option |> Option.map Lang.to_source + in + match s with | None -> ( - last_select <- Unix.gettimeofday (); - let s = - Lang.apply f [] |> Lang.to_option |> Option.map Lang.to_source - in - match s with - | None -> ( - match Atomic.get source with - | Some s - when self#can_reselect - ~reselect: - (match reselect with - | `Force -> `Ok - | v -> v) - s -> - Some s - | _ -> None) - | Some s -> self#prepare s)) + match self#current_source with + | Some s + when self#can_reselect + ~reselect: + (match reselect with `Force -> `Ok | v -> v) + s -> + Some s + | _ -> self#no_source) + | Some s -> self#exchange s) () method private get_source ~reselect () = - match (Atomic.get source, reselect) with - | None, _ | _, `Force -> self#get_next reselect + match (self#current_source, reselect) with + | None, _ | _, `Force | Some _, `After_position _ -> + self#get_next reselect | Some s, _ when self#can_reselect ~reselect s -> Some s - | Some _, _ when Unix.gettimeofday () -. last_select < resurection_time - -> - None | _ -> self#get_next reselect initializer self#on_wake_up (fun () -> Lang.iter_sources (fun s -> Typing.(s#frame_type <: self#frame_type)) - f; + next_fn; ignore (self#get_source ~reselect:`Force ())); self#on_sleep (fun () -> - match Atomic.exchange source None with + match Atomic.exchange current_source None with | Some s -> s#sleep | None -> ()) method remaining = - match Atomic.get source with Some s -> s#remaining | None -> -1 + match self#current_source with Some s -> s#remaining | None -> -1 method abort_track = - match Atomic.get source with Some s -> s#abort_track | None -> () + match self#current_source with Some s -> s#abort_track | None -> () method seek_source = - match Atomic.get source with + match self#current_source with | Some s -> s#seek_source | None -> (self :> Source.source) @@ -106,7 +107,7 @@ class dyn ~init ~track_sensitive ~infallible ~resurection_time ~self_sync f = | Some v -> (`Static, self#source_sync v) | None -> ( ( `Dynamic, - match Atomic.get source with + match self#current_source with | Some s -> snd s#self_sync | None -> None )) end @@ -133,16 +134,13 @@ let _ = Lang.nullable_t Lang.bool_t, Some Lang.null, Some "For the source's `self_sync` property." ); - ( "resurection_time", - Lang.nullable_t Lang.float_t, - Some (Lang.float 1.), - Some - "When track sensitive and the source is unavailable, how long we \ - should wait before trying to update source again (`null` means \ - never)." ); + ( "merge", + Lang.getter_t Lang.bool_t, + Some (Lang.bool false), + Some "Set or return `true` to merge subsequent tracks." ); ( "", Lang.fun_t [] (Lang.nullable_t (Lang.source_t frame_t)), - Some (Lang.val_fun [] (fun _ -> Lang.null)), + None, Some "Function returning the source to be used, `null` means keep current \ source." ); @@ -152,17 +150,25 @@ let _ = "Dynamically change the underlying source: it can either be changed by \ the function given as argument, which returns the source to be played, \ or by calling the `set` method." - ~category:`Track ~flags:[`Experimental] + ~category:`Track ~meth: [ - ( "set", + ( "current_source", + ([], Lang.fun_t [] (Lang.nullable_t (Lang.source_t frame_t))), + "Return the source currently selected.", + fun s -> + Lang.val_fun [] (fun _ -> + match s#current_source with + | None -> Lang.null + | Some s -> Lang.source s) ); + ( "prepare", ([], Lang.fun_t [(false, "", Lang.source_t frame_t)] Lang.unit_t), - "Set the source.", + "Prepare a source that will be returned later.", fun s -> Lang.val_fun [("", "x", None)] (fun p -> - s#propose (List.assoc "x" p |> Lang.to_source); + s#prepare (List.assoc "x" p |> Lang.to_source); Lang.unit) ); ] (fun p -> @@ -172,13 +178,10 @@ let _ = let track_sensitive = List.assoc "track_sensitive" p |> Lang.to_getter in let track_sensitive () = Lang.to_bool (track_sensitive ()) in let infallible = List.assoc "infallible" p |> Lang.to_bool in - let resurection_time = - List.assoc "resurection_time" p |> Lang.to_valued_option Lang.to_float - in - let resurection_time = Option.value ~default:(-1.) resurection_time in + let merge = Lang.to_getter (List.assoc "merge" p) in + let merge () = Lang.to_bool (merge ()) in let self_sync = Lang.to_valued_option Lang.to_bool (List.assoc "self_sync" p) in let next = List.assoc "" p in - new dyn - ~init ~track_sensitive ~infallible ~resurection_time ~self_sync next) + new dyn ~init ~track_sensitive ~infallible ~merge ~self_sync next) diff --git a/src/libs/extra/source.liq b/src/libs/extra/source.liq index 9fe862053f..727dc5cf60 100644 --- a/src/libs/extra/source.liq +++ b/src/libs/extra/source.liq @@ -195,7 +195,7 @@ end # @param ~every Duration of a track (in seconds). # @param ~metadata Metadata for tracks. # @param s The stream. -def chop(~every=getter(3.), ~metadata=getter([]), s) = +def chop(~id=null(), ~every=getter(3.), ~metadata=getter([]), s) = s = insert_metadata(s) # Track time in the source's context: @@ -211,7 +211,7 @@ def chop(~every=getter(3.), ~metadata=getter([]), s) = end end - source.on_frame(s, f) + source.on_frame(id=id, s, f) end # Regularly skip tracks from a source (useful for testing skipping). diff --git a/src/libs/request.liq b/src/libs/request.liq index 511d312b5b..675c779481 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -43,9 +43,10 @@ def request.queue( ) = ignore(native) id = string.id.default(default="request.queue", id) - initial_queue = queue + initial_queue = ref(queue) queue = ref([]) fetch = ref(fun () -> true) + started = ref(false) def next() = if @@ -60,13 +61,23 @@ def request.queue( end def push(r) = - log.info( - label=id, - "Pushing #{r} on the queue." - ) - queue := [...queue(), r] - fn = fetch() - ignore(fn()) + if + started() + then + log.info( + label=id, + "Pushing #{r} on the queue." + ) + queue := [...queue(), r] + fn = fetch() + ignore(fn()) + else + log.info( + label=id, + "Pushing #{r} on the initial queue." + ) + initial_queue := [...initial_queue(), r] + end end def push_uri(uri) = @@ -110,12 +121,12 @@ def request.queue( end def set_queue(q) = - queue := q + if started() then queue := q else initial_queue := q end s.set_queue([]) end def get_queue() = - [...s.queue(), ...(queue())] + [...s.queue(), ...initial_queue(), ...queue()] end s = @@ -127,7 +138,14 @@ def request.queue( queue=get_queue } - s.on_wake_up({s.set_queue(initial_queue)}) + s.on_wake_up( + fun () -> + begin + started := true + s.set_queue(initial_queue()) + initial_queue := [] + end + ) source.set_name(s, "request.queue") fetch := s.fetch @@ -432,10 +450,20 @@ def request.player(~simultaneous=true) = } } else - s = source.dynamic() + next_source = ref(null()) + + def next() = + s = next_source() + next_source := null() + s + end + + s = source.dynamic(next) def play(r) = - s.set(request.once(r)) + r = request.once(r) + s.prepare(r) + next_source := r end s.{play=play, length={1}} diff --git a/src/libs/source.liq b/src/libs/source.liq index 24526c93ea..d5c0e87576 100644 --- a/src/libs/source.liq +++ b/src/libs/source.liq @@ -173,39 +173,42 @@ def append(~id=null("append"), ~insert_missing=true, ~merge=false, s, f) = last_meta = ref(null()) pending = ref(null()) - def f(m) = - if - m["liq_append"] == "false" - then - last_meta := null() - pending := null() - elsif - last_meta() != m - then - last_meta := m - pending := (f(m) : source?) - end - end - - s = if insert_missing then source.on_track(s, f) else s end - s = source.on_metadata(s, f) - def next() = p = pending() pending := null() last_meta := null() + if null.defined(p) then null.get(p) else (s : source) end + end + + d = + source.dynamic( + track_sensitive=true, merge={merge and null.defined(pending)}, next + ) + + def f(m) = if - null.defined(p) + d.current_source() == (s : source) then - p = null.get(p) - sequence(merge=merge, [p, s]) - else - null() + if + m["liq_append"] == "false" + then + last_meta := null() + pending := null() + elsif + last_meta() != m + then + last_meta := m + s = f(m) + d.prepare(s) + pending := s + end end end - d = source.dynamic(track_sensitive=false, next) + d = if insert_missing then source.on_track(d, f) else d end + d = source.on_metadata(d, f) + s = fallback(id=id, track_sensitive=false, [d, s]) s.{ pending= diff --git a/src/libs/video.liq b/src/libs/video.liq index 9797af4d58..b81e8cd1ff 100644 --- a/src/libs/video.liq +++ b/src/libs/video.liq @@ -34,27 +34,24 @@ def request.image( ~y=getter(0), req ) = - s = source.dynamic() - last_req = ref(null()) - def set_req() = + def next() = req = (getter.get(req) : request) if req != last_req() then + last_req := req image = request.single(id=id, fallible=fallible, req) image = video.crop(image) - image = video.resize(id=id, x=x, y=y, width=width, height=height, image) - s.set(image) - last_req := req + video.resize(id=id, x=x, y=y, width=width, height=height, image) + else + null() end end - s.on_wake_up(set_req) - - source.on_frame(s, set_req) + source.dynamic(id=id, track_sensitive=false, next) end # Generate a source from an image file. @@ -197,34 +194,45 @@ end # @category Source / Video processing # @param s Audio source whose metadata contain cover-art. def video.cover(s) = - video = source.dynamic() + last_filename = ref(null()) + fail = (source.fail() : source) + + def next() = + m = source.last_metadata(s ?? fail) ?? [] - def read_cover(m) = filename = m["filename"] - cover = - if file.exists(filename) then file.cover(filename) else "".{mime=""} end if - null.defined(cover) + filename != last_filename() then - cover = null.get(cover) - ext = if cover.mime == "image/png" then ".png" else ".jpg" end - f = file.temp("cover", ext) - log.debug( - "Found cover for #{filename}." - ) - file.write(data=cover, f) - video.set(request.once(request.create(temporary=true, f))) + last_filename := filename + + cover = + if file.exists(filename) then file.cover(filename) else "".{mime=""} end + + if + null.defined(cover) + then + cover = null.get(cover) + ext = if cover.mime == "image/png" then ".png" else ".jpg" end + f = file.temp("cover", ext) + log.debug( + "Found cover for #{filename}." + ) + file.write(data=cover, f) + request.once(request.create(temporary=true, f)) + else + log.debug( + "No cover for #{filename}." + ) + fail + end else - log.debug( - "No cover for #{filename}." - ) - video.set(source.fail()) + null() end end - s.on_track(read_cover) - (video : source(video=canvas)) + source.dynamic(track_sensitive=false, next) end let output.youtube = () @@ -652,7 +660,16 @@ def video.slideshow( id = string.id.default(default="video.slideshow", id) l = ref(l) n = ref(-1) - s = source.dynamic() + + next_source = ref(null()) + + def next() = + s = next_source() + next_source := null() + s + end + + s = source.dynamic(next) def current() = list.nth(l(), n()) @@ -664,7 +681,9 @@ def video.slideshow( 0 <= n' and n' < list.length(l()) and n' != n() then n := n' - s.set(request.once(request.create(current()))) + new_source = request.once(request.create(current())) + s.prepare(new_source) + next_source := new_source end end From 93e457a15b725ee05de47b196c09abcb12684659 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 7 Oct 2024 11:28:30 -0400 Subject: [PATCH 037/151] Add spinitron API functions. (#4158) --- CHANGES.md | 1 + src/libs/extra/spinitron.liq | 277 +++++++++++++++++++++++++++++++++++ src/libs/stdlib.liq | 1 + 3 files changed, 279 insertions(+) create mode 100644 src/libs/extra/spinitron.liq diff --git a/CHANGES.md b/CHANGES.md index 3fe09d0f5c..0a67b1ccd6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -23,6 +23,7 @@ New: - Optimized runtime (#3927, #3928, #3919) - Added `finally` to execute code regardless of whether or not an exception is raised (see: #3895 for more details). +- Added support for Spinitron submission API (#4158) - Removed gstreamer support. Gstreamer's architecture was never a good fit for us and created a huge maintenance and debugging burden and it had been marked as deprecated for a while. Most, if not all of its features should be available using diff --git a/src/libs/extra/spinitron.liq b/src/libs/extra/spinitron.liq new file mode 100644 index 0000000000..3dc050ce7f --- /dev/null +++ b/src/libs/extra/spinitron.liq @@ -0,0 +1,277 @@ +let spinitron = {submit=()} + +# Submit a track to the spinitron track system +# and return the raw response. +# @category Interaction +# @flag extra +# @param ~api_key API key +def spinitron.submit.raw( + ~host="https://spinitron.com/api", + ~api_key, + ~live=false, + ~start=null(), + ~duration=null(), + ~artist, + ~release=null(), + ~label=null(), + ~genre=null(), + ~song, + ~composer=null(), + ~isrc=null() +) = + params = [("song", song), ("artist", artist)] + + def fold_optional_string_params(params, param) = + let (label, param) = param + if + null.defined(param) + then + [(label, null.get(param)), ...params] + else + params + end + end + + params = + list.fold( + fold_optional_string_params, + params, + [ + ("live", null.map(fun (b) -> b ? "1" : "0" , (live : bool?))), + ("start", start), + ("duration", null.map(string, (duration : int?))), + ("release", release), + ("label", label), + ("genre", genre), + ("composer", composer), + ("isrc", isrc) + ] + ) + + def encode_param(param) = + let (label, param) = param + "#{label}=#{url.encode(param)}" + end + + params = string.concat(separator="&", list.map(encode_param, params)) + + http.post( + data=params, + headers= + [ + ("Accept", "application/json"), + ("Content-Type", "application/x-www-form-urlencoded"), + ( + "Authorization", + "Bearer #{(api_key : string)}" + ) + ], + "#{host}/spins" + ) +end + +# Submit a track to the spinitron track system +# and return the parsed response +# @category Interaction +# @flag extra +# @param ~api_key API key +def replaces spinitron.submit(%argsof(spinitron.submit.raw)) = + resp = spinitron.submit.raw(%argsof(spinitron.submit.raw)) + + if + resp.status_code == 201 + then + let json.parse (resp : + { + id: int, + playlist_id: int, + "start" as spin_start: string, + "end" as spin_end: string?, + duration: int?, + timezone: string?, + image: string?, + classical: bool?, + artist: string, + "artist-custom" as artist_custom: string?, + composer: string?, + release: string?, + "release-custom" as release_custom: string?, + va: bool?, + label: string?, + "label-custom" as label_custom: string?, + released: int?, + medium: string?, + genre: string?, + song: string, + note: string?, + request: bool?, + local: bool?, + new: bool?, + work: string?, + conductor: string?, + performers: string?, + ensemble: string?, + "catalog-number" as catalog_number: string?, + isrc: string?, + upc: string?, + iswc: string?, + "_links" as links: {self: {href: string}?, playlist: {href: string}?}? + } + ) = resp + + resp + elsif + resp.status_code == 422 + then + let json.parse (errors : [{field: string, message: string}]) = resp + + errors = + list.map( + fun (p) -> + begin + let {field, message} = p + "#{field}: #{message}" + end, + errors + ) + + errors = + string.concat( + separator= + ", ", + errors + ) + + error.raise( + error.raise( + error.http, + "Invalid fields: #{errors}" + ) + ) + else + let json.parse ({name, message, code, status, type} : + {name: string, message: string, code: int, status: int, type: string?} + ) = resp + + type = type ?? "undefined" + + error.raise( + error.raise( + error.http, + "#{name}: #{message} (code: #{code}, status: #{status}, type: #{type})" + ) + ) + end +end + +# Submit a spin using the given metadata to the spinitron track system +# and return the parsed response. `artist` and `song` (or `title`) must +# be present either as metadata or as optional argument. +# @category Interaction +# @flag extra +# @param m Metadata to submit. Overrides optional arguments when present. +# @param ~mapper Metadata mapper that can be used to map metadata fields to spinitron's expected. \ +# Returned metadata are added to the submitted metadata. By default, `title` is \ +# mapped to `song` and `album` to `release` if neither of those passed otherwise. +# @param ~api_key API key +def spinitron.submit.metadata( + %argsof(spinitron.submit[!artist,!song]), + ~mapper=( + fun (m) -> + [ + ...(m["song"] != "" or m["title"] == "" ? [] : [("song", m["title"])] ), + ...( + m["release"] != "" or m["album"] == "" + ? [] : [("release", m["album"])] + ) + ] + ), + ~artist=null(), + ~song=null(), + m +) = + m = [...m, ...mapper(m)] + + def conv_opt_arg(convert, label, default) = + list.assoc.mem(label, m) ? convert(m[label]) : default + end + + opt_arg = + fun (label, default) -> conv_opt_arg(fun (x) -> null(x), label, default) + + live = conv_opt_arg(bool_of_string, "live", live) + start = opt_arg("start", start) + duration = conv_opt_arg(int_of_string, "duration", duration) + artist = opt_arg("artist", artist) + release = opt_arg("release", release) + label = opt_arg("label", label) + genre = opt_arg("genre", genre) + song = opt_arg("song", song) + composer = opt_arg("composer", composer) + isrc = opt_arg("isrc", isrc) + + if + artist == null() or song == null() + then + error.raise( + error.invalid, + "Both \"artist\" and \"song\" (or \"title\" metadata) must be provided!" + ) + end + + artist = null.get(artist) + song = null.get(song) + + res = spinitron.submit(%argsof(spinitron.submit)) + + print(res) + + res +end + +# Specialized version of `source.on_metadata` that submits spins using +# the source's metadata to the spinitron track system. `artist` and `song` +# (or `title`) must be present either as metadata or as optional argument. +# @category Interaction +# @flag extra +# @param m Metadata to submit. Overrides optional arguments when present. +# @param ~api_key API key +def spinitron.submit.on_metadata( + ~id=null(), + %argsof(spinitron.submit.metadata), + s +) = + def on_metadata(m) = + if + m["title"] == "" and m["song"] == "" + then + log.severe( + label=source.id(s), + "Field \"song\" or \"title\" missing, skipping metadata spinitron \ + submission." + ) + elsif + m["artist"] == "" + then + log.severe( + label=source.id(s), + "Field \"artist\" missing, skipping metadata spinitron submission." + ) + else + try + ignore(spinitron.submit.metadata(%argsof(spinitron.submit.metadata), m)) + log.important( + label=source.id(s), + "Successfully submitted spin from metadata" + ) + catch err do + log.severe( + label=source.id(s), + "Error while submitting spin from metadata: #{err}" + ) + end + end + end + + source.on_metadata(id=id, s, on_metadata) +end diff --git a/src/libs/stdlib.liq b/src/libs/stdlib.liq index c58ae30c42..dacb255f90 100644 --- a/src/libs/stdlib.liq +++ b/src/libs/stdlib.liq @@ -54,6 +54,7 @@ %include_extra "extra/interactive.liq" %include_extra "extra/visualization.liq" %include_extra "extra/openai.liq" +%include_extra "extra/spinitron.liq" %include_extra "extra/metadata.liq" %include_extra "extra/fades.liq" %include_extra "extra/video.liq" From ba356e83cc00fcfa4e86e989ce12878daeb1c592 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 7 Oct 2024 14:12:00 -0400 Subject: [PATCH 038/151] Disable logs when values are zero, treat them as explicit disabled state. --- src/core/operators/cross.ml | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/core/operators/cross.ml b/src/core/operators/cross.ml index 2c9c91270d..44082dea5f 100644 --- a/src/core/operators/cross.ml +++ b/src/core/operators/cross.ml @@ -82,7 +82,10 @@ class cross val_source ~end_duration_getter ~override_end_duration self#log#important "Cannot set crossfade end duration to negative value %f!" end_duration; - frame_size) + frame_size + (* Accept zero as simplify disabled crossfade. Set to frame_size. *)) + else if _end_main_duration = 0 then frame_size + (* For any non-zero too short value, warn the user. *) else if _end_main_duration < frame_size then ( self#log#important "Cannot set crossfade end duration to less than the frame size!"; @@ -99,7 +102,10 @@ class cross val_source ~end_duration_getter ~override_end_duration self#log#important "Cannot set crossfade start duration to negative value %f!" start_duration; - frame_size) + frame_size + (* Accept zero as simplify disabled crossfade. Set to frame_size. *)) + else if _start_main_duration = 0 then frame_size + (* For any non-zero too short value, warn the user. *) else if _start_main_duration < frame_size then ( self#log#important "Cannot set crossfade start duration to less than the frame size!"; From 49298dadc160b9834c34b262085611337558760d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 7 Oct 2024 14:15:15 -0400 Subject: [PATCH 039/151] Print positions in this log. --- src/core/request.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/request.ml b/src/core/request.ml index 74773d990c..bc7e404d27 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -591,7 +591,10 @@ let get_decoder ~ctype r = else ( if Frame.is_partial buf then r.logger#important - "End of track reached before cue-out point!"; + "End of track reached at %.02f before cue-out point at \ + %.02f!" + (Frame.seconds_of_main new_pos) + (Frame.seconds_of_main cue_out); buf)) in let remaining () = From f2117c1e8424f110a5ea9f246413fdbb5255bbe9 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 8 Oct 2024 14:11:05 -0400 Subject: [PATCH 040/151] Fix `blank.strip` (#4164) --- src/core/operators/noblank.ml | 21 +++++++++++------- tests/regression/GH4163.liq | 42 +++++++++++++++++++++++++++++++++++ tests/regression/dune.inc | 16 +++++++++++++ 3 files changed, 71 insertions(+), 8 deletions(-) create mode 100644 tests/regression/GH4163.liq diff --git a/src/core/operators/noblank.ml b/src/core/operators/noblank.ml index 61b4f2a485..dd75c96169 100644 --- a/src/core/operators/noblank.ml +++ b/src/core/operators/noblank.ml @@ -122,7 +122,13 @@ class strip ~start_blank ~max_blank ~min_noise ~threshold ~track_sensitive inherit active_operator ~name:"blank.strip" [source] inherit base ~track_sensitive ~start_blank ~max_blank ~min_noise ~threshold method fallible = true - method private can_generate_frame = (not self#is_blank) && source#is_ready + + method private can_generate_frame = + (* This needs to be computed at all times as it makes sure that the + source is ready to be ready from in [#output]. *) + let is_source_ready = source#is_ready in + (not self#is_blank) && is_source_ready + method remaining = if self#is_blank then 0 else source#remaining method seek_source = @@ -130,14 +136,10 @@ class strip ~start_blank ~max_blank ~min_noise ~threshold ~track_sensitive method abort_track = source#abort_track method self_sync = source#self_sync - - method private generate_frame = - let buf = source#get_frame in - self#check_blank buf; - buf + method private generate_frame = source#get_frame method private output = - if source#is_ready && self#is_blank then ignore self#get_frame + if source#is_ready then self#check_blank source#get_frame method reset = () end @@ -294,7 +296,10 @@ let _ = in Lang.add_operator ~base:Blank.blank "strip" ~return_t:frame_t ~meth:(meth ()) ~category:`Track - ~descr:"Make the source unavailable when it is streaming blank." + ~descr: + "Make the source unavailable when it is streaming blank. This is an \ + active operator, meaning that the source used in this operator will be \ + consumed continuously, even when it is not actively used." (proto frame_t) (fun p -> let start_blank, max_blank, min_noise, threshold, track_sensitive, s = extract p diff --git a/tests/regression/GH4163.liq b/tests/regression/GH4163.liq new file mode 100644 index 0000000000..65cc60a845 --- /dev/null +++ b/tests/regression/GH4163.liq @@ -0,0 +1,42 @@ +first_blank = + metadata.map( + id="first_blank", fun (_) -> [("title", "first_blank")], blank(duration=3.) + ) + +after_blank = + metadata.map( + id="after_blank", fun (_) -> [("title", "after_blank")], sine(duration=10.) + ) + +blank_sequence = sequence(id="blank_sequence", [first_blank, after_blank]) + +blank_strip = + blank.strip(id="blank_strip", max_blank=5., start_blank=true, blank_sequence) + +fallback_sine = + metadata.map(id="fallback_sine", fun (_) -> [("title", "fallback")], sine()) + +s = + fallback( + id="main_source", track_sensitive=false, [blank_strip, fallback_sine] + ) + +# We want to make sure that blank.strip keeps eating the blank source before switching back: +expected_titles = ["fallback", "after_blank"] +seen_titles = ref([]) + +def on_metadata(m) = + seen_titles := [...seen_titles(), m["title"]] + if + seen_titles() == expected_titles + then + test.pass() + elsif list.length(seen_titles()) == 2 then test.fail() + end +end + +s = source.on_metadata(id="on_meta", s, on_metadata) + +clock.assign_new(sync='none', [s]) + +output.dummy(s) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index 20f642d5aa..b21d4f2764 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -735,6 +735,22 @@ (:run_test ../run_test.exe)) (action (run %{run_test} GH4144.liq liquidsoap %{test_liq} GH4144.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + GH4163.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} GH4163.liq liquidsoap %{test_liq} GH4163.liq))) + (rule (alias citest) (package liquidsoap) From 65678e52effcc47f8fcd1b2f34cf952d2812110f Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 8 Oct 2024 14:32:13 -0500 Subject: [PATCH 041/151] FFmpeg filters: keep value in TS unit, move time-based values to `_time` postfixed entries. Autocue: sort frames by pts. --- src/core/io/ffmpeg_filter_io.ml | 5 ++++- src/libs/autocue.liq | 20 ++++++++++++++++---- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/src/core/io/ffmpeg_filter_io.ml b/src/core/io/ffmpeg_filter_io.ml index 4de2552ba5..258675e5e5 100644 --- a/src/core/io/ffmpeg_filter_io.ml +++ b/src/core/io/ffmpeg_filter_io.ml @@ -195,7 +195,10 @@ class virtual ['a] input_base ~name ~pass_metadata ~self_sync ~is_ready ~pull (fun result (label, fn) -> match fn frame with | None -> result - | Some v -> ("lavfi.liq." ^ label, get_time v) :: result) + | Some v -> + ("lavfi.liq." ^ label, Int64.to_string v) + :: ("lavfi.liq." ^ label ^ "_time", get_time v) + :: result) [] [ ("pts", Avutil.Frame.pts); diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index c5738937ee..1f6136cecf 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -228,7 +228,17 @@ def autocue.internal.ebur128(~ratio=50., ~timeout=10., filename) = s = source.on_metadata(s, fun (m) -> frames := [...frames(), m]) source.drop(ratio=ratio, s) - frames() + list.sort( + fun (m, m') -> + begin + pos = + float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", m)) + pos' = + float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", m')) + if pos < pos' then -1 elsif pos < pos' then 1 else 0 end + end, + frames() + ) end %else ignore(ratio) @@ -387,7 +397,7 @@ def autocue.internal.implementation( # Get current frame loudness level and timestamp db_level = list.assoc(default="nan", string("lavfi.r128.M"), frame) current_ts := - float_of_string(list.assoc(default="0.", "lavfi.liq.pts", frame)) + float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", frame)) # Process only valid level values if @@ -708,8 +718,10 @@ def autocue.internal.implementation( # Get very last frame for precise track duration frame = list.last(frames) duration = - float_of_string(list.assoc(default="0.", "lavfi.liq.pts", frame)) + - float_of_string(list.assoc(default="0.", "lavfi.liq.duration", frame)) + float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", frame)) + + float_of_string( + list.assoc(default="0.", "lavfi.liq.duration_time", frame) + ) # Finalize cue/cross/fade values now... if cue_out() == 0. then cue_out := duration end From ea1b3ee81fc5d83ddc8ea1360e378956a0c04b24 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 9 Oct 2024 09:08:50 -0500 Subject: [PATCH 042/151] Add warning about frame duration in autocue/ebur128 filter. --- src/libs/autocue.liq | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index 1f6136cecf..0737598c58 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -717,11 +717,31 @@ def autocue.internal.implementation( # Get very last frame for precise track duration frame = list.last(frames) + frame_duration = + float_of_string( + list.assoc(default="0.", "lavfi.liq.duration_time", frame) + ) + + frame_duration = + if + frame_duration != 100. + then + log.important( + label="autocue", + "Warning: reported frame duration should be 100ms. Either the FFmpeg \ + ebur128 filter has changed its internals or the version/build of \ + FFmpeg you are using is buggy. We recommend using a fairly recent \ + distribution with FFmpeg version 7 or above. Backported packages \ + can be tricky." + ) + 100. + else + frame_duration + end + duration = float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", frame)) + - float_of_string( - list.assoc(default="0.", "lavfi.liq.duration_time", frame) - ) + frame_duration # Finalize cue/cross/fade values now... if cue_out() == 0. then cue_out := duration end From be448ef3323516ddf0626615ef2d3cfd6f3353c8 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 9 Oct 2024 09:42:44 -0500 Subject: [PATCH 043/151] Add request.duration., use it to get a precise duration in autocue. --- CHANGES.md | 2 +- src/core/builtins/builtins_request.ml | 113 ++++++++++++++++---------- src/core/decoder/ffmpeg_decoder.ml | 2 +- src/core/request.ml | 9 +- src/core/request.mli | 11 ++- src/libs/autocue.liq | 75 +++++++++++------ 6 files changed, 135 insertions(+), 77 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 0a67b1ccd6..b4f77005dc 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -150,7 +150,7 @@ Fixed: - Make sure reconnection errors are router through the regulat `on_error` callback in `output.icecast` (#3635) - Fixed discontinuity count after a restart in HLS outputs. - Fixed file header logic when reopening in `output.file` (#3675) -- Fixed memory leaks when using dynamically created sources (`input.harbor`, `input.ffmepg`, SRT sources and `request.dynamic`) +- Fixed memory leaks when using dynamically created sources (`input.harbor`, `input.ffmpeg`, SRT sources and `request.dynamic`) - Fixed invalid array fill in `add` (#3678) - Fixed deadlock when connecting to a non-SSL icecast using the TLS transport (#3681) - Fixed crash when closing external process (#3685) diff --git a/src/core/builtins/builtins_request.ml b/src/core/builtins/builtins_request.ml index 3d20fee528..1cd2b8a8a6 100644 --- a/src/core/builtins/builtins_request.ml +++ b/src/core/builtins/builtins_request.ml @@ -185,48 +185,77 @@ let _ = Lang.unit) let _ = - Lang.add_builtin ~base:request "duration" ~category:`Liquidsoap - [ - ( "resolve_metadata", - Lang.bool_t, - Some (Lang.bool true), - Some "Set to `false` to prevent metadata resolution on this request." ); - ( "metadata", - Lang.metadata_t, - Some (Lang.list []), - Some "Optional metadata used to decode the file, e.g. `ffmpeg_options`." - ); - ( "timeout", - Lang.float_t, - Some (Lang.float 30.), - Some "Limit in seconds to the duration of the resolving." ); - ("", Lang.string_t, None, None); - ] - (Lang.nullable_t Lang.float_t) - ~descr: - "Compute the duration in seconds of audio data contained in a request. \ - The computation may be expensive. Returns `null` if computation failed, \ - typically if the file was not recognized as valid audio." - (fun p -> - let f = Lang.to_string (List.assoc "" p) in - let resolve_metadata = Lang.to_bool (List.assoc "resolve_metadata" p) in - let metadata = Lang.to_metadata (List.assoc "metadata" p) in - let timeout = Lang.to_float (List.assoc "timeout" p) in - let r = - Request.create ~resolve_metadata ~metadata ~cue_in_metadata:None - ~cue_out_metadata:None f - in - if Request.resolve r timeout = `Resolved then ( - match - Request.duration ~metadata:(Request.metadata r) - (Option.get (Request.get_filename r)) - with - | Some f -> Lang.float f - | None -> Lang.null - | exception exn -> - let bt = Printexc.get_raw_backtrace () in - Lang.raise_as_runtime ~bt ~kind:"failure" exn) - else Lang.null) + let add_duration_resolver ~base ~name ~resolver () = + Lang.add_builtin ~base name ~category:`Liquidsoap + ((if resolver = None then + [ + ( "resolvers", + Lang.nullable_t (Lang.list_t Lang.string_t), + Some Lang.null, + Some + "Set to a list of resolvers to only resolve duration using a \ + specific decoder." ); + ] + else []) + @ [ + ( "resolve_metadata", + Lang.bool_t, + Some (Lang.bool true), + Some + "Set to `false` to prevent metadata resolution on this request." + ); + ( "metadata", + Lang.metadata_t, + Some (Lang.list []), + Some + "Optional metadata used to decode the file, e.g. \ + `ffmpeg_options`." ); + ( "timeout", + Lang.float_t, + Some (Lang.float 30.), + Some "Limit in seconds to the duration of the resolving." ); + ("", Lang.string_t, None, None); + ]) + (Lang.nullable_t Lang.float_t) + ~descr: + "Compute the duration in seconds of audio data contained in a request. \ + The computation may be expensive. Returns `null` if computation \ + failed, typically if the file was not recognized as valid audio." + (fun p -> + let f = Lang.to_string (List.assoc "" p) in + let resolve_metadata = Lang.to_bool (List.assoc "resolve_metadata" p) in + let resolvers = + match resolver with + | None -> + Option.map (List.map Lang.to_string) + (Lang.to_valued_option Lang.to_list (List.assoc "resolvers" p)) + | Some r -> Some [r] + in + let metadata = Lang.to_metadata (List.assoc "metadata" p) in + let timeout = Lang.to_float (List.assoc "timeout" p) in + let r = + Request.create ~resolve_metadata ~metadata ~cue_in_metadata:None + ~cue_out_metadata:None f + in + if Request.resolve r timeout = `Resolved then ( + match + Request.duration ?resolvers ~metadata:(Request.metadata r) + (Option.get (Request.get_filename r)) + with + | Some f -> Lang.float f + | None -> Lang.null + | exception exn -> + let bt = Printexc.get_raw_backtrace () in + Lang.raise_as_runtime ~bt ~kind:"failure" exn) + else Lang.null) + in + let base = + add_duration_resolver ~base:request ~name:"duration" ~resolver:None () + in + List.iter + (fun name -> + ignore (add_duration_resolver ~base ~name ~resolver:(Some name) ())) + Request.conf_dresolvers#get let _ = Lang.add_builtin ~base:request "id" ~category:`Liquidsoap diff --git a/src/core/decoder/ffmpeg_decoder.ml b/src/core/decoder/ffmpeg_decoder.ml index 054ac0179f..06ed6e552d 100644 --- a/src/core/decoder/ffmpeg_decoder.ml +++ b/src/core/decoder/ffmpeg_decoder.ml @@ -558,7 +558,7 @@ let dresolver ~metadata file = Option.map (fun d -> Int64.to_float d /. 1000.) duration) let () = - Plug.register Request.dresolvers "ffmepg" ~doc:"" + Plug.register Request.dresolvers "ffmpeg" ~doc:"" { dpriority = (fun () -> priority#get); file_extensions = (fun () -> file_extensions#get); diff --git a/src/core/request.ml b/src/core/request.ml index bc7e404d27..11407289be 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -160,7 +160,7 @@ let get_dresolvers ~file () = (fun (_, a) (_, b) -> compare (b.dpriority ()) (a.dpriority ())) resolvers -let compute_duration ~metadata file = +let compute_duration ?resolvers ~metadata file = try List.iter (fun (name, { dpriority; dresolver }) -> @@ -168,6 +168,9 @@ let compute_duration ~metadata file = log#info "Trying duration resolver %s (priority: %d) for file %s.." name (dpriority ()) (Lang_string.quote_string file); + (match resolvers with + | Some l when not (List.mem name l) -> raise Not_found + | _ -> ()); let ans = dresolver ~metadata file in raise (Duration ans) with @@ -177,7 +180,7 @@ let compute_duration ~metadata file = raise Not_found with Duration d -> d -let duration ~metadata file = +let duration ?resolvers ~metadata file = try match ( Frame.Metadata.find_opt "duration" metadata, @@ -189,7 +192,7 @@ let duration ~metadata file = | _, None, Some cue_out -> Some (float_of_string cue_out) | Some v, _, _ -> Some (float_of_string v) | None, cue_in, None -> - let duration = compute_duration ~metadata file in + let duration = compute_duration ?resolvers ~metadata file in let duration = match cue_in with | Some cue_in -> duration -. float_of_string cue_in diff --git a/src/core/request.mli b/src/core/request.mli index a17b637942..f5052c6558 100644 --- a/src/core/request.mli +++ b/src/core/request.mli @@ -147,10 +147,15 @@ val log : t -> string These operations are only meaningful for media requests, and might raise exceptions otherwise. *) -(** [duration ~metadata filename] computes the duration of audio data contained in - [filename]. The computation may be expensive. +(** Duration resolvers. *) +val conf_dresolvers : string list Dtools.Conf.t + +(** [duration ?resolvers ~metadata filename] computes the duration of audio data contained in + [filename]. The computation may be expensive. Set [resolvers] to a list of specific decoders + to use for getting duration. @raise Not_found if no duration computation method is found. *) -val duration : metadata:Frame.metadata -> string -> float option +val duration : + ?resolvers:string list -> metadata:Frame.metadata -> string -> float option (** [true] is a decoder exists for the given content-type. *) val has_decoder : ctype:Frame.content_type -> t -> bool diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index 0737598c58..1f9c8fb83e 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -715,36 +715,57 @@ def autocue.internal.implementation( end end - # Get very last frame for precise track duration - frame = list.last(frames) - frame_duration = - float_of_string( - list.assoc(default="0.", "lavfi.liq.duration_time", frame) - ) + # Finalize cue/cross/fade values now... + if + cue_out() == 0. + then + file_duration = + begin + # Duration from the filter frames can be tricky so we first try a proper duration: + request_duration = +%ifdef request.duration.ffmpeg + request.duration.ffmpeg(resolve_metadata=false, filename) +%else + null() +%endif - frame_duration = - if - frame_duration != 100. - then - log.important( - label="autocue", - "Warning: reported frame duration should be 100ms. Either the FFmpeg \ - ebur128 filter has changed its internals or the version/build of \ - FFmpeg you are using is buggy. We recommend using a fairly recent \ - distribution with FFmpeg version 7 or above. Backported packages \ - can be tricky." - ) - 100. - else - frame_duration - end + if + null.defined(request_duration) + then + null.get(request_duration) + else + # Get very last frame for precise track duration + frame_duration = + float_of_string( + list.assoc(default="0.", "lavfi.liq.duration_time", frame) + ) - duration = - float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", frame)) + - frame_duration + frame_duration = + if + frame_duration != 0.1 + then + log.important( + label="autocue", + "Warning: reported frame duration should be 100ms. Either \ + the FFmpeg ebur128 filter has changed its internals or the \ + version/build of FFmpeg you are using is buggy. We \ + recommend using a fairly recent distribution with FFmpeg \ + version 7 or above. Backported packages can be tricky." + ) + 0.1 + else + frame_duration + end + + float_of_string( + list.assoc(default="0.", "lavfi.liq.pts_time", frame) + ) + + frame_duration + end + end - # Finalize cue/cross/fade values now... - if cue_out() == 0. then cue_out := duration end + cue_out := file_duration + end # Calc cross/overlap duration if From 4dc4d24800fbe4612e0ce3be9df0482004ec5aec Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 9 Oct 2024 09:55:07 -0500 Subject: [PATCH 044/151] Reuse initial request.duration. --- src/libs/autocue.liq | 829 +++++++++++++++++++++---------------------- 1 file changed, 403 insertions(+), 426 deletions(-) diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index 1f9c8fb83e..e124a61b46 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -184,13 +184,12 @@ end # Get frames from ffmpeg.filter.ebur128 # @flag hidden -def autocue.internal.ebur128(~ratio=50., ~timeout=10., filename) = +def autocue.internal.ebur128(~duration, ~ratio=50., ~timeout=10., filename) = ignore(ratio) ignore(timeout) ignore(filename) + ignore(duration) %ifdef ffmpeg.filter.ebur128 - duration = - null.get(default=0., request.duration(resolve_metadata=false, filename)) estimated_processing_time = duration / ratio if @@ -297,408 +296,441 @@ def autocue.internal.implementation( "Starting to process #{filename}" ) - frames = autocue.internal.ebur128(ratio=ratio, timeout=timeout, filename) +%ifdef request.duration.ffmpeg + duration = request.duration.ffmpeg(resolve_metadata=false, filename) +%else + duration = null() +%endif if - list.length(frames) < 2 + duration == null() then log( level=2, label="autocue.internal", - "Autocue computation failed!" + "Could not get request duration, internal autocue disabled!" ) null() else - # Get the 2nd last frame which is the last with loudness data - frame = list.nth(frames, list.length(frames) - 2) + duration = null.get(duration) - # Get the Integrated Loudness from the last frame (overall loudness) - lufs = - float_of_string( - list.assoc(default=string(lufs_target), "lavfi.r128.I", frame) + frames = + autocue.internal.ebur128( + duration=duration, ratio=ratio, timeout=timeout, filename ) - # Calc LUFS difference to target for liq_amplify - lufs_correction = lufs_target - lufs + if + list.length(frames) < 2 + then + log( + level=2, + label="autocue.internal", + "Autocue computation failed!" + ) + null() + else + # Get the 2nd last frame which is the last with loudness data + frame = list.nth(frames, list.length(frames) - 2) - # Create dB thresholds relative to LUFS target - lufs_cue_in_threshold = lufs + cue_in_threshold - lufs_cue_out_threshold = lufs + cue_out_threshold - lufs_cross_threshold = lufs + cross_threshold + # Get the Integrated Loudness from the last frame (overall loudness) + lufs = + float_of_string( + list.assoc(default=string(lufs_target), "lavfi.r128.I", frame) + ) - log( - level=4, - label="autocue.internal", - "Processing results for #{filename}" - ) + # Calc LUFS difference to target for liq_amplify + lufs_correction = lufs_target - lufs - log( - level=4, - label="autocue.internal", - "lufs_correction: #{lufs_correction}" - ) - log( - level=4, - label="autocue.internal", - "lufs_cue_in_threshold: #{lufs_cue_in_threshold}" - ) - log( - level=4, - label="autocue.internal", - "lufs_cue_out_threshold: #{lufs_cue_out_threshold}" - ) - log( - level=4, - label="autocue.internal", - "lufs_cross_threshold: #{lufs_cross_threshold}" - ) + # Create dB thresholds relative to LUFS target + lufs_cue_in_threshold = lufs + cue_in_threshold + lufs_cue_out_threshold = lufs + cue_out_threshold + lufs_cross_threshold = lufs + cross_threshold - # Set cue/fade defaults - cue_in = ref(0.) - cue_out = ref(0.) - cross_cue = ref(0.) - fade_in = ref(0.) - fade_out = ref(0.) - - # Extract timestamps for cue points - # Iterate over loudness data frames and set cue points based on db thresholds - last_ts = ref(0.) - current_ts = ref(0.) - cue_found = ref(false) - cross_start_idx = ref(0.) - cross_stop_idx = ref(0.) - cross_mid_idx = ref(0.) - cross_frame_length = ref(0.) - ending_fst_db = ref(0.) - ending_snd_db = ref(0.) - reset_iter_values = ref(true) - - frames_rev = list.rev(frames) - total_frames_length = float_of_int(list.length(frames)) - frame_idx = ref(total_frames_length - 1.) - lufs_cross_threshold_sustained = ref(lufs_cross_threshold) - lufs_cue_out_threshold_sustained = ref(lufs_cue_out_threshold) - - err = error.register("assoc") - def find_cues( - frame, - ~reverse_order=false, - ~sustained_ending_check=false, - ~sustained_ending_recalc=false - ) = - if - reset_iter_values() - then - last_ts := 0. - current_ts := 0. - cue_found := false - end + log( + level=4, + label="autocue.internal", + "Processing results for #{filename}" + ) - # Get current frame loudness level and timestamp - db_level = list.assoc(default="nan", string("lavfi.r128.M"), frame) - current_ts := - float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", frame)) + log( + level=4, + label="autocue.internal", + "lufs_correction: #{lufs_correction}" + ) + log( + level=4, + label="autocue.internal", + "lufs_cue_in_threshold: #{lufs_cue_in_threshold}" + ) + log( + level=4, + label="autocue.internal", + "lufs_cue_out_threshold: #{lufs_cue_out_threshold}" + ) + log( + level=4, + label="autocue.internal", + "lufs_cross_threshold: #{lufs_cross_threshold}" + ) - # Process only valid level values - if - db_level != "nan" - then - db_level = float_of_string(db_level) + # Set cue/fade defaults + cue_in = ref(0.) + cue_out = ref(0.) + cross_cue = ref(0.) + fade_in = ref(0.) + fade_out = ref(0.) + + # Extract timestamps for cue points + # Iterate over loudness data frames and set cue points based on db thresholds + last_ts = ref(0.) + current_ts = ref(0.) + cue_found = ref(false) + cross_start_idx = ref(0.) + cross_stop_idx = ref(0.) + cross_mid_idx = ref(0.) + cross_frame_length = ref(0.) + ending_fst_db = ref(0.) + ending_snd_db = ref(0.) + reset_iter_values = ref(true) + + frames_rev = list.rev(frames) + total_frames_length = float_of_int(list.length(frames)) + frame_idx = ref(total_frames_length - 1.) + lufs_cross_threshold_sustained = ref(lufs_cross_threshold) + lufs_cue_out_threshold_sustained = ref(lufs_cue_out_threshold) + + err = error.register("assoc") + def find_cues( + frame, + ~reverse_order=false, + ~sustained_ending_check=false, + ~sustained_ending_recalc=false + ) = + if + reset_iter_values() + then + last_ts := 0. + current_ts := 0. + cue_found := false + end + # Get current frame loudness level and timestamp + db_level = list.assoc(default="nan", string("lavfi.r128.M"), frame) + current_ts := + float_of_string( + list.assoc(default="0.", "lavfi.liq.pts_time", frame) + ) + + # Process only valid level values if - not sustained_ending_check and not sustained_ending_recalc + db_level != "nan" then - # Run regular cue point calc - reset_iter_values := false + db_level = float_of_string(db_level) + if - not reverse_order + not sustained_ending_check and not sustained_ending_recalc then - # Search for cue in + # Run regular cue point calc + reset_iter_values := false if - db_level > lufs_cue_in_threshold + not reverse_order then - # First time exceeding threshold - cue_in := last_ts() + # Search for cue in + if + db_level > lufs_cue_in_threshold + then + # First time exceeding threshold + cue_in := last_ts() - # Break - error.raise( - err, - "break list.iter" - ) + # Break + error.raise( + err, + "break list.iter" + ) + end + else + # Search for cue out and crossfade point starting from the end (reversed) + if + db_level > lufs_cue_out_threshold and not cue_found() + then + # Cue out + cue_out := last_ts() + cross_stop_idx := frame_idx() + cue_found := true + elsif + db_level > lufs_cross_threshold + then + # Absolute crossfade cue + cross_cue := last_ts() + cross_start_idx := frame_idx() + + # Break + error.raise( + err, + "break list.iter" + ) + end + frame_idx := frame_idx() - 1. end - else - # Search for cue out and crossfade point starting from the end (reversed) + elsif + sustained_ending_check + then + # Check regular crossfade data for sustained ending if - db_level > lufs_cue_out_threshold and not cue_found() + reset_iter_values() then - # Cue out - cue_out := last_ts() - cross_stop_idx := frame_idx() - cue_found := true - elsif - db_level > lufs_cross_threshold - then - # Absolute crossfade cue - cross_cue := last_ts() - cross_start_idx := frame_idx() + frame_idx := total_frames_length - 1. + cross_start_idx := cross_start_idx() + 5. + cross_stop_idx := cross_stop_idx() - 5. + cross_frame_length := cross_stop_idx() - cross_start_idx() + cross_mid_idx := cross_stop_idx() - (cross_frame_length() / 2.) + end + reset_iter_values := false - # Break + if + frame_idx() < cross_start_idx() + or + cross_frame_length() < sustained_endings_min_duration * 10. + then error.raise( err, "break list.iter" ) end - frame_idx := frame_idx() - 1. - end - elsif - sustained_ending_check - then - # Check regular crossfade data for sustained ending - if - reset_iter_values() - then - frame_idx := total_frames_length - 1. - cross_start_idx := cross_start_idx() + 5. - cross_stop_idx := cross_stop_idx() - 5. - cross_frame_length := cross_stop_idx() - cross_start_idx() - cross_mid_idx := cross_stop_idx() - (cross_frame_length() / 2.) - end - reset_iter_values := false - if - frame_idx() < cross_start_idx() - or - cross_frame_length() < sustained_endings_min_duration * 10. - then - error.raise( - err, - "break list.iter" - ) - end - - if - frame_idx() < cross_stop_idx() and frame_idx() > cross_mid_idx() - then if - ending_snd_db() < 0. + frame_idx() < cross_stop_idx() and frame_idx() > cross_mid_idx() then - ending_snd_db := (ending_snd_db() + db_level) / 2. - else - ending_snd_db := db_level + if + ending_snd_db() < 0. + then + ending_snd_db := (ending_snd_db() + db_level) / 2. + else + ending_snd_db := db_level + end end - end - if - frame_idx() > cross_start_idx() and frame_idx() < cross_mid_idx() - then if - ending_fst_db() < 0. + frame_idx() > cross_start_idx() + and + frame_idx() < cross_mid_idx() then - ending_fst_db := (ending_fst_db() + db_level) / 2. - else - ending_fst_db := db_level + if + ending_fst_db() < 0. + then + ending_fst_db := (ending_fst_db() + db_level) / 2. + else + ending_fst_db := db_level + end end - end - frame_idx := frame_idx() - 1. - elsif - sustained_ending_recalc - then - # Recalculate crossfade on sustained ending - if - reset_iter_values() - then - cue_out := 0. - cross_cue := 0. - end - reset_iter_values := false - if - db_level > lufs_cue_out_threshold_sustained() and not cue_found() - then - # Cue out - cue_out := last_ts() - cue_found := true - end - if - db_level > lufs_cross_threshold_sustained() + frame_idx := frame_idx() - 1. + elsif + sustained_ending_recalc then - # Absolute crossfade cue - cross_cue := current_ts() - error.raise( - err, - "break list.iter" - ) + # Recalculate crossfade on sustained ending + if + reset_iter_values() + then + cue_out := 0. + cross_cue := 0. + end + reset_iter_values := false + if + db_level > lufs_cue_out_threshold_sustained() + and + not cue_found() + then + # Cue out + cue_out := last_ts() + cue_found := true + end + if + db_level > lufs_cross_threshold_sustained() + then + # Absolute crossfade cue + cross_cue := current_ts() + error.raise( + err, + "break list.iter" + ) + end end - end - # Update last timestamp value with current - last_ts := current_ts() + # Update last timestamp value with current + last_ts := current_ts() + end end - end - - # Search for cue_in first - reset_iter_values := true - def cue_iter_fwd(frame) = - find_cues(frame) - end - try - list.iter(cue_iter_fwd, frames) - catch _ do - log( - level=4, - label="autocue.internal", - "cue_iter_fwd completed." - ) - end - # Reverse frames and search in reverse order for cross_cue and cue_out - reset_iter_values := true - def cue_iter_rev(frame) = - find_cues(frame, reverse_order=true) - end - try - list.iter(cue_iter_rev, frames_rev) - catch _ do - log( - level=4, - label="autocue.internal", - "cue_iter_rev completed." - ) - end - - if - sustained_endings_enabled - then - # Check for sustained ending + # Search for cue_in first reset_iter_values := true - def sustained_ending_check_iter(frame) = - find_cues(frame, sustained_ending_check=true) + def cue_iter_fwd(frame) = + find_cues(frame) end try - list.iter(sustained_ending_check_iter, frames_rev) + list.iter(cue_iter_fwd, frames) catch _ do log( level=4, - label="autocue.internal.sustained_ending", - "sustained_ending_check_iter completed." + label="autocue.internal", + "cue_iter_fwd completed." ) end - log( - level=4, - label="autocue.internal.sustained_ending", - "Analysis frame length: #{cross_frame_length()}" - ) - log( - level=4, - label="autocue.internal.sustained_ending", - "Avg. ending loudness: #{ending_fst_db()} => #{ending_snd_db()}" - ) + # Reverse frames and search in reverse order for cross_cue and cue_out + reset_iter_values := true + def cue_iter_rev(frame) = + find_cues(frame, reverse_order=true) + end + try + list.iter(cue_iter_rev, frames_rev) + catch _ do + log( + level=4, + label="autocue.internal", + "cue_iter_rev completed." + ) + end - # Check whether data indicate a sustained ending if - ending_fst_db() < 0. + sustained_endings_enabled then - slope = ref(0.) - dropoff = lufs_cross_threshold / ending_fst_db() - - if - ending_snd_db() < 0. - then - slope := ending_fst_db() / ending_snd_db() + # Check for sustained ending + reset_iter_values := true + def sustained_ending_check_iter(frame) = + find_cues(frame, sustained_ending_check=true) + end + try + list.iter(sustained_ending_check_iter, frames_rev) + catch _ do + log( + level=4, + label="autocue.internal.sustained_ending", + "sustained_ending_check_iter completed." + ) end log( level=4, label="autocue.internal.sustained_ending", - "Drop off: #{(1. - dropoff) * 100.}%" + "Analysis frame length: #{cross_frame_length()}" ) log( level=4, label="autocue.internal.sustained_ending", - "Slope: #{(1. - slope()) * 100.}%" + "Avg. ending loudness: #{ending_fst_db()} => #{ending_snd_db()}" ) - detect_slope = slope() > 1. - sustained_endings_slope / 100. - detect_dropoff = - ending_fst_db() > - lufs_cross_threshold * (sustained_endings_dropoff / 100. + 1.) + # Check whether data indicate a sustained ending if - detect_slope or detect_dropoff + ending_fst_db() < 0. then - log( - level=3, - label="autocue.internal.sustained_ending", - "Sustained ending detected (drop off: #{detect_dropoff} / slope: #{ - detect_slope - })" - ) + slope = ref(0.) + dropoff = lufs_cross_threshold / ending_fst_db() if - detect_slope + ending_snd_db() < 0. then - lufs_cross_threshold_sustained := - max( - lufs_cross_threshold * sustained_endings_threshold_limit, - ending_snd_db() - 0.5 - ) - else - lufs_cross_threshold_sustained := - max( - lufs_cross_threshold * sustained_endings_threshold_limit, - ending_fst_db() - 0.5 - ) + slope := ending_fst_db() / ending_snd_db() end - lufs_cue_out_threshold_sustained = - ref( - max( - lufs_cue_out_threshold * sustained_endings_threshold_limit, - lufs_cue_out_threshold + - (lufs_cross_threshold_sustained() - lufs_cross_threshold) - ) - ) log( level=4, label="autocue.internal.sustained_ending", - "Changed crossfade threshold: #{lufs_cross_threshold} => #{ - lufs_cross_threshold_sustained() - }" + "Drop off: #{(1. - dropoff) * 100.}%" ) log( level=4, label="autocue.internal.sustained_ending", - "Changed cue out threshold: #{lufs_cue_out_threshold} => #{ - lufs_cue_out_threshold_sustained() - }" + "Slope: #{(1. - slope()) * 100.}%" ) - cross_cue_init = cross_cue() - cue_out_init = cue_out() + detect_slope = slope() > 1. - sustained_endings_slope / 100. + detect_dropoff = + ending_fst_db() > + lufs_cross_threshold * (sustained_endings_dropoff / 100. + 1.) + if + detect_slope or detect_dropoff + then + log( + level=3, + label="autocue.internal.sustained_ending", + "Sustained ending detected (drop off: #{detect_dropoff} / slope: \ + #{detect_slope})" + ) + + if + detect_slope + then + lufs_cross_threshold_sustained := + max( + lufs_cross_threshold * sustained_endings_threshold_limit, + ending_snd_db() - 0.5 + ) + else + lufs_cross_threshold_sustained := + max( + lufs_cross_threshold * sustained_endings_threshold_limit, + ending_fst_db() - 0.5 + ) + end + lufs_cue_out_threshold_sustained = + ref( + max( + lufs_cue_out_threshold * sustained_endings_threshold_limit, + lufs_cue_out_threshold + + (lufs_cross_threshold_sustained() - lufs_cross_threshold) + ) + ) - reset_iter_values := true - def sustained_ending_recalc_iter(frame) = - find_cues(frame, sustained_ending_recalc=true) - end - try - list.iter(sustained_ending_recalc_iter, frames_rev) - catch _ do log( level=4, - label="autocue.internal", - "sustained_ending_recalc_iter completed." + label="autocue.internal.sustained_ending", + "Changed crossfade threshold: #{lufs_cross_threshold} => #{ + lufs_cross_threshold_sustained() + }" + ) + log( + level=4, + label="autocue.internal.sustained_ending", + "Changed cue out threshold: #{lufs_cue_out_threshold} => #{ + lufs_cue_out_threshold_sustained() + }" ) - end - log( - level=4, - label="autocue.internal.sustained_ending", - "Changed crossfade point: #{cross_cue_init} => #{cross_cue()}" - ) - log( - level=4, - label="autocue.internal.sustained_ending", - "Changed cue out point: #{cue_out_init} => #{cue_out()}" - ) + cross_cue_init = cross_cue() + cue_out_init = cue_out() + + reset_iter_values := true + def sustained_ending_recalc_iter(frame) = + find_cues(frame, sustained_ending_recalc=true) + end + try + list.iter(sustained_ending_recalc_iter, frames_rev) + catch _ do + log( + level=4, + label="autocue.internal", + "sustained_ending_recalc_iter completed." + ) + end + + log( + level=4, + label="autocue.internal.sustained_ending", + "Changed crossfade point: #{cross_cue_init} => #{cross_cue()}" + ) + log( + level=4, + label="autocue.internal.sustained_ending", + "Changed cue out point: #{cue_out_init} => #{cue_out()}" + ) + else + log( + level=3, + label="autocue.internal.sustained_ending", + "No sustained ending detected." + ) + end else log( level=3, @@ -706,129 +738,74 @@ def autocue.internal.implementation( "No sustained ending detected." ) end - else - log( - level=3, - label="autocue.internal.sustained_ending", - "No sustained ending detected." - ) end - end - - # Finalize cue/cross/fade values now... - if - cue_out() == 0. - then - file_duration = - begin - # Duration from the filter frames can be tricky so we first try a proper duration: - request_duration = -%ifdef request.duration.ffmpeg - request.duration.ffmpeg(resolve_metadata=false, filename) -%else - null() -%endif - if - null.defined(request_duration) - then - null.get(request_duration) - else - # Get very last frame for precise track duration - frame_duration = - float_of_string( - list.assoc(default="0.", "lavfi.liq.duration_time", frame) - ) + # Finalize cue/cross/fade values now... + if cue_out() == 0. then cue_out := duration end - frame_duration = - if - frame_duration != 0.1 - then - log.important( - label="autocue", - "Warning: reported frame duration should be 100ms. Either \ - the FFmpeg ebur128 filter has changed its internals or the \ - version/build of FFmpeg you are using is buggy. We \ - recommend using a fairly recent distribution with FFmpeg \ - version 7 or above. Backported packages can be tricky." - ) - 0.1 - else - frame_duration - end - - float_of_string( - list.assoc(default="0.", "lavfi.liq.pts_time", frame) - ) + - frame_duration - end - end - - cue_out := file_duration - end + # Calc cross/overlap duration + if + cross_cue() + 0.1 < cue_out() + then + fade_out := cue_out() - cross_cue() + end - # Calc cross/overlap duration - if - cross_cue() + 0.1 < cue_out() - then - fade_out := cue_out() - cross_cue() - end + # Add some margin to cue in + cue_in := cue_in() - 0.1 - # Add some margin to cue in - cue_in := cue_in() - 0.1 + # Avoid hard cuts on cue in + if + cue_in() > 0.2 + then + fade_in := 0.2 + cue_in := cue_in() - 0.2 + end - # Avoid hard cuts on cue in - if - cue_in() > 0.2 - then - fade_in := 0.2 - cue_in := cue_in() - 0.2 - end + # Ignore super short cue in + if + cue_in() <= 0.2 + then + fade_in := 0. + cue_in := 0. + end - # Ignore super short cue in - if - cue_in() <= 0.2 - then - fade_in := 0. - cue_in := 0. - end + # Limit overlap duration to maximum + if max_overlap < fade_in() then fade_in := max_overlap end - # Limit overlap duration to maximum - if max_overlap < fade_in() then fade_in := max_overlap end + if + max_overlap < fade_out() + then + cue_shift = fade_out() - max_overlap + cue_out := cue_out() - cue_shift + fade_out := max_overlap + fade_out := max_overlap + end - if - max_overlap < fade_out() - then - cue_shift = fade_out() - max_overlap - cue_out := cue_out() - cue_shift - fade_out := max_overlap - fade_out := max_overlap + ( + { + amplify= + "#{lufs_correction} dB", + cue_in=cue_in(), + cue_out=cue_out(), + fade_in=fade_in(), + fade_out=fade_out() + } + : + { + amplify?: string, + cue_in: float, + cue_out: float, + fade_in: float, + fade_in_type?: string, + fade_in_curve?: float, + fade_out: float, + fade_out_type?: string, + fade_out_curve?: float, + start_next?: float, + extra_metadata?: [(string*string)] + } + ) end - - ( - { - amplify= - "#{lufs_correction} dB", - cue_in=cue_in(), - cue_out=cue_out(), - fade_in=fade_in(), - fade_out=fade_out() - } - : - { - amplify?: string, - cue_in: float, - cue_out: float, - fade_in: float, - fade_in_type?: string, - fade_in_curve?: float, - fade_out: float, - fade_out_type?: string, - fade_out_curve?: float, - start_next?: float, - extra_metadata?: [(string*string)] - } - ) end end end From 0a58e4358e376c2681ef77672167b4a2092498e1 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 10 Oct 2024 15:18:53 -0500 Subject: [PATCH 045/151] Better log. --- src/core/builtins/builtins_request.ml | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/core/builtins/builtins_request.ml b/src/core/builtins/builtins_request.ml index 1cd2b8a8a6..9797595208 100644 --- a/src/core/builtins/builtins_request.ml +++ b/src/core/builtins/builtins_request.ml @@ -218,9 +218,14 @@ let _ = ]) (Lang.nullable_t Lang.float_t) ~descr: - "Compute the duration in seconds of audio data contained in a request. \ - The computation may be expensive. Returns `null` if computation \ - failed, typically if the file was not recognized as valid audio." + (Printf.sprintf + "Compute the duration in seconds of audio data contained in a \ + request%s. The computation may be expensive. Returns `null` if \ + computation failed, typically if the file was not recognized as \ + valid audio." + (match resolver with + | Some r -> " using the " ^ r ^ " decoder" + | None -> "")) (fun p -> let f = Lang.to_string (List.assoc "" p) in let resolve_metadata = Lang.to_bool (List.assoc "resolve_metadata" p) in From 77761772f770c9f66d49d8c42d915c51caae5ee8 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 10 Oct 2024 15:05:45 -0500 Subject: [PATCH 046/151] Reset last metadata on new track by default (#4166) --- src/core/lang_source.ml | 11 ++++++++++- src/core/source.ml | 9 +++++++++ src/core/source.mli | 3 +++ tests/regression/append.liq | 29 ++++++++++++++++------------- 4 files changed, 38 insertions(+), 14 deletions(-) diff --git a/src/core/lang_source.ml b/src/core/lang_source.ml index eb6c3c630a..53fe0231ac 100644 --- a/src/core/lang_source.ml +++ b/src/core/lang_source.ml @@ -156,7 +156,16 @@ let source_methods = "Indicate if a source is ready to stream. This does not mean that the \ source is currently streaming, just that its resources are all properly \ initialized.", - fun (s : Source.source) -> val_fun [] (fun _ -> bool s#is_ready) ); + fun s -> val_fun [] (fun _ -> bool s#is_ready) ); + ( "reset_last_metadata_on_track", + ([], ref_t bool_t), + "If `true`, the source's `last_metadata` is reset on each new track. If \ + a metadata is present along with the track mark, then it becomes the \ + new `last_metadata`, otherwise, `last_metadata becomes `null`.", + fun s -> + reference + (fun () -> bool s#reset_last_metadata_on_track) + (fun b -> s#set_reset_last_metadata_on_track (to_bool b)) ); ( "buffered", ([], fun_t [] (list_t (product_t string_t float_t))), "Length of buffered data.", diff --git a/src/core/source.ml b/src/core/source.ml index a34dcc9da6..2b75c74235 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -425,6 +425,14 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = initializer self#on_before_streaming_cycle (fun () -> on_track_called <- false) + val mutable reset_last_metadata_on_track = Atomic.make true + + method reset_last_metadata_on_track = + Atomic.get reset_last_metadata_on_track + + method set_reset_last_metadata_on_track = + Atomic.set reset_last_metadata_on_track + val mutable on_track : (Frame.metadata -> unit) List.t = [] method on_track fn = on_track <- fn :: on_track @@ -436,6 +444,7 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = method private execute_on_track buf = if not on_track_called then ( on_track_called <- true; + if self#reset_last_metadata_on_track then last_metadata <- None; self#set_last_metadata buf; let m = Option.value ~default:Frame.Metadata.empty last_metadata in self#log#debug "calling on_track handlers.."; diff --git a/src/core/source.mli b/src/core/source.mli index 8dfda5e6bc..71cc42efaa 100644 --- a/src/core/source.mli +++ b/src/core/source.mli @@ -216,6 +216,9 @@ class virtual source : (** The source's last metadata. *) method last_metadata : Frame.metadata option + method reset_last_metadata_on_track : bool + method set_reset_last_metadata_on_track : bool -> unit + (** Register a callback to be called on new metadata *) method on_metadata : (Frame.metadata -> unit) -> unit diff --git a/tests/regression/append.liq b/tests/regression/append.liq index fc353283a2..468248e2fa 100644 --- a/tests/regression/append.liq +++ b/tests/regression/append.liq @@ -1,8 +1,7 @@ music = chop(every=1., metadata=[("source", "s1")], sine(amplitude=0.1, 440.)) def next(_) = - s = sine(amplitude=0.1, duration=.5, 880.) - metadata.map(insert_missing=true, fun (_) -> [("source", "s2")], s) + sine(amplitude=0.1, duration=.5, 880.) end s = append(music, next) @@ -10,17 +9,21 @@ s = append(music, next) count_s1 = ref(0) count_s2 = ref(0) -s.on_metadata(fun (m) -> begin - s = m["source"] - if s == "s1" then - ref.incr(count_s1) - elsif s == "s2" then - ref.incr(count_s2) - end +s.on_track( + fun (m) -> + begin + s = m["source"] + if + s == "s1" + then + ref.incr(count_s1) + else + test.equal(m["source"], "") + ref.incr(count_s2) + end - if count_s1() > 2 and count_s2() > 2 then - test.pass() - end -end) + if count_s1() > 2 and count_s2() > 2 then test.pass() end + end +) output.dummy(s) From 19a392a016fb05e7aafb7b8c7403cd158e72e707 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 10 Oct 2024 16:10:11 -0500 Subject: [PATCH 047/151] Add macos_say. (#4167) --- CHANGES.md | 2 ++ src/libs/protocols.liq | 42 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 42 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index b4f77005dc..3c24992907 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -60,6 +60,8 @@ New: - Added `source.cue` (#3620). - Added `string.chars` (#4111) - Added atomic file write operations. +- Added new `macos_say` speech synthesis protocol. Make it the default implementation for the `say:` + protocol on `macos`. Changed: diff --git a/src/libs/protocols.liq b/src/libs/protocols.liq index 5fb5b9397f..71d51c4990 100644 --- a/src/libs/protocols.liq +++ b/src/libs/protocols.liq @@ -791,14 +791,52 @@ protocol.add( "gtts:Text to read" ) +# MacOS say +let settings.protocol.macos_say = settings.make.protocol("macos_say") +let settings.protocol.macos_say.path = + settings.make( + description= + "Path to the say binary", + "say" + ) + +let settings.protocol.macos_say.options = + settings.make( + description= + "Command line options.", + "" + ) + +# Register the macos_say: protocol using the say command available on macos +# @flag hidden +def protocol.macos_say(~rlog=_, ~maxtime=_, arg) = + binary = settings.protocol.macos_say.path() + options = settings.protocol.macos_say.options() + process.uri( + extname="aiff", + "#{binary} #{options} -o $(output) #{process.quote(arg)}" + ) +end + +protocol.add( + static=true, + "macos_say", + protocol.macos_say, + doc= + "Generate speech synthesis using the `say` command available on macos.", + syntax= + "macos_say:Text to read" +) + # Say let settings.protocol.say = settings.make.protocol("say") let settings.protocol.say.implementation = settings.make( description= - "Implementation to use. One of: \"pico2wave\", \"gtts\" or \"text2wave\".", - "pico2wave" + "Implementation to use. One of: \"pico2wave\", \"gtts\", \"text2wave\" or \ + \"macos_say\".", + liquidsoap.build_config.system == "macosx" ? "macos_say" : "pico2wave" ) # Register the legacy say: protocol From fdb4b752c818ade71ebf33fdcacf6b770c539fef Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 10 Oct 2024 19:27:29 -0500 Subject: [PATCH 048/151] Fix append logic (#4169) --- src/core/operators/sequence.ml | 13 ++++++++++--- src/core/source.ml | 6 +++++- src/libs/extra/source.liq | 5 ++++- tests/regression/append-merge2.liq | 26 ++++++++++++++++++++++++++ tests/regression/dune.inc | 16 ++++++++++++++++ 5 files changed, 61 insertions(+), 5 deletions(-) create mode 100644 tests/regression/append-merge2.liq diff --git a/src/core/operators/sequence.ml b/src/core/operators/sequence.ml index 796840c141..277bc1c3fe 100644 --- a/src/core/operators/sequence.ml +++ b/src/core/operators/sequence.ml @@ -57,7 +57,7 @@ class sequence ?(merge = false) ?(single_track = true) sources = has_started <- List.exists (fun s -> s#is_ready) self#queue; has_started - method private get_source ~reselect () = + method private get_stateful_source ?(source_skipped = false) ~reselect () = match (self#has_started, self#queue) with | _, [] -> None | true, s :: [] -> @@ -72,16 +72,23 @@ class sequence ?(merge = false) ?(single_track = true) sources = self#can_reselect ~reselect: (match reselect with - | `After_position _ when single_track -> `Force + | `After_position _ + when (not source_skipped) && single_track -> + `Force | v -> v) s then Some s else ( self#log#info "Finished with %s" s#id; Atomic.set seq_sources rest; - self#get_source ~reselect:`Ok ()) + self#get_stateful_source ~source_skipped:true + ~reselect:(match reselect with `Force -> `Ok | v -> v) + ()) | _ -> None + method private get_source ~reselect () = + self#get_stateful_source ~reselect () + method remaining = if merge then ( let ( + ) a b = if a < 0 || b < 0 then -1 else a + b in diff --git a/src/core/source.ml b/src/core/source.ml index 2b75c74235..d741b6fab5 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -637,13 +637,17 @@ class virtual generate_from_multiple_sources ~merge ~track_sensitive () = match self#get_source ~reselect:(`After_position last_chunk_pos) () with - | Some s' when last_source == s' -> + | Some s when last_source == s -> let remainder = s#get_partial_frame (fun frame -> assert (last_chunk_pos < Frame.position frame); Frame.slice frame (last_chunk_pos + rem)) in let new_track = Frame.after remainder last_chunk_pos in + let new_track = + if merge () then Frame.drop_track_marks new_track + else new_track + in f ~last_source ~last_chunk:remainder (Frame.append buf new_track) | Some s -> diff --git a/src/libs/extra/source.liq b/src/libs/extra/source.liq index 727dc5cf60..1f3eaf83b8 100644 --- a/src/libs/extra/source.liq +++ b/src/libs/extra/source.liq @@ -201,11 +201,14 @@ def chop(~id=null(), ~every=getter(3.), ~metadata=getter([]), s) = # Track time in the source's context: time = ref(0.) + is_first = ref(true) + def f() = time := time() + settings.frame.duration() if - getter.get(every) <= time() + is_first() or getter.get(every) <= time() then + is_first := false time := 0. s.insert_metadata(new_track=true, getter.get(metadata)) end diff --git a/tests/regression/append-merge2.liq b/tests/regression/append-merge2.liq new file mode 100644 index 0000000000..cde0b530cf --- /dev/null +++ b/tests/regression/append-merge2.liq @@ -0,0 +1,26 @@ +music = chop(every=1., metadata=[("title", "music")], sine(amplitude=0.1, 440.)) + +jingles = chop(every=1., metadata=[("title", "jingle")], sine(amplitude=0.1, 220.)) + +def next(_) = + sequence(merge=true, [jingles, jingles, source.fail()]) +end + +s = append(music, next) + +meta_seen = ref([]) + +s.on_metadata( + fun (m) -> begin + meta_seen := [...meta_seen(), m["title"]] + + if list.length(meta_seen()) == 9 then + test.equal(meta_seen(), ["music", "jingle", "jingle", "music", "jingle", "jingle", "music", "jingle", "jingle",]) + test.pass() + end + end +) + +clock.assign_new(sync='none', [s]) + +output.dummy(s) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index b21d4f2764..e8c347a689 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -847,6 +847,22 @@ (:run_test ../run_test.exe)) (action (run %{run_test} append-merge.liq liquidsoap %{test_liq} append-merge.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + append-merge2.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} append-merge2.liq liquidsoap %{test_liq} append-merge2.liq))) + (rule (alias citest) (package liquidsoap) From 3d7ebd85099de4f2dd3ffd53e732d4ab6ce8bcea Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 11 Oct 2024 00:18:21 -0500 Subject: [PATCH 049/151] =?UTF-8?q?Revert=20"FFmpeg=20filters:=20keep=20va?= =?UTF-8?q?lue=20in=20TS=20unit,=20move=20time-based=20values=E2=80=A6=20(?= =?UTF-8?q?#4168)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/core/io/ffmpeg_filter_io.ml | 5 +---- src/libs/autocue.liq | 16 ++-------------- 2 files changed, 3 insertions(+), 18 deletions(-) diff --git a/src/core/io/ffmpeg_filter_io.ml b/src/core/io/ffmpeg_filter_io.ml index 258675e5e5..4de2552ba5 100644 --- a/src/core/io/ffmpeg_filter_io.ml +++ b/src/core/io/ffmpeg_filter_io.ml @@ -195,10 +195,7 @@ class virtual ['a] input_base ~name ~pass_metadata ~self_sync ~is_ready ~pull (fun result (label, fn) -> match fn frame with | None -> result - | Some v -> - ("lavfi.liq." ^ label, Int64.to_string v) - :: ("lavfi.liq." ^ label ^ "_time", get_time v) - :: result) + | Some v -> ("lavfi.liq." ^ label, get_time v) :: result) [] [ ("pts", Avutil.Frame.pts); diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index e124a61b46..065cfc32b8 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -227,17 +227,7 @@ def autocue.internal.ebur128(~duration, ~ratio=50., ~timeout=10., filename) = s = source.on_metadata(s, fun (m) -> frames := [...frames(), m]) source.drop(ratio=ratio, s) - list.sort( - fun (m, m') -> - begin - pos = - float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", m)) - pos' = - float_of_string(list.assoc(default="0.", "lavfi.liq.pts_time", m')) - if pos < pos' then -1 elsif pos < pos' then 1 else 0 end - end, - frames() - ) + frames() end %else ignore(ratio) @@ -417,9 +407,7 @@ def autocue.internal.implementation( # Get current frame loudness level and timestamp db_level = list.assoc(default="nan", string("lavfi.r128.M"), frame) current_ts := - float_of_string( - list.assoc(default="0.", "lavfi.liq.pts_time", frame) - ) + float_of_string(list.assoc(default="0.", "lavfi.liq.pts", frame)) # Process only valid level values if From 7c8f2d9ed5e09ee6cbf0ba95e70c4b5b7b37784a Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 12 Oct 2024 18:20:08 -0500 Subject: [PATCH 050/151] Make sure we test for reselection when `source.dynamic` callback returns the current source (#4172) --- src/core/operators/dyn_op.ml | 39 +++++++++++++++++-------------- src/core/sources/debug_sources.ml | 26 ++++++++++++++++++++- tests/regression/GH4159.liq | 5 ++++ tests/regression/dune.inc | 16 +++++++++++++ 4 files changed, 68 insertions(+), 18 deletions(-) create mode 100644 tests/regression/GH4159.liq diff --git a/src/core/operators/dyn_op.ml b/src/core/operators/dyn_op.ml index 01c60d48ac..a290e71070 100644 --- a/src/core/operators/dyn_op.ml +++ b/src/core/operators/dyn_op.ml @@ -28,7 +28,6 @@ class dyn ~init ~track_sensitive ~infallible ~self_sync ~merge next_fn = val mutable activation = [] val current_source : Source.source option Atomic.t = Atomic.make init method current_source = Atomic.get current_source - val mutable last_select = Unix.gettimeofday () method private no_source = if infallible then @@ -48,29 +47,35 @@ class dyn ~init ~track_sensitive ~infallible ~self_sync ~merge next_fn = s#wake_up method private exchange s = - self#log#info "Switching to source %s" s#id; - self#prepare s; - Atomic.set current_source (Some s); - if s#is_ready then Some s else self#no_source + match self#current_source with + | Some s' when s == s' -> Some s + | _ -> + self#log#info "Switching to source %s" s#id; + self#prepare s; + Atomic.set current_source (Some s); + if s#is_ready then Some s else self#no_source method private get_next reselect = self#mutexify (fun () -> - last_select <- Unix.gettimeofday (); let s = Lang.apply next_fn [] |> Lang.to_option |> Option.map Lang.to_source in - match s with - | None -> ( - match self#current_source with - | Some s - when self#can_reselect - ~reselect: - (match reselect with `Force -> `Ok | v -> v) - s -> - Some s - | _ -> self#no_source) - | Some s -> self#exchange s) + match (s, self#current_source) with + | None, Some s + when self#can_reselect + ~reselect:(match reselect with `Force -> `Ok | v -> v) + s -> + Some s + | Some s, Some s' when s == s' -> + if + self#can_reselect + ~reselect:(match reselect with `Force -> `Ok | v -> v) + s + then Some s + else self#no_source + | Some s, _ -> self#exchange s + | _ -> self#no_source) () method private get_source ~reselect () = diff --git a/src/core/sources/debug_sources.ml b/src/core/sources/debug_sources.ml index db0d0594c7..a8dec07838 100644 --- a/src/core/sources/debug_sources.ml +++ b/src/core/sources/debug_sources.ml @@ -58,4 +58,28 @@ let _ = ~descr: "A source that errors during its initialization phase, used for testing \ and debugging." ~flags:[`Experimental] ~return_t [] (fun _ -> - (new fail_init :> Source.source)) + new fail_init) + +class is_ready s = + object (self) + inherit Source.operator ~name:"is_ready" [s] + method seek_source = (self :> Source.source) + method fallible = true + method private can_generate_frame = true + method self_sync = (`Static, None) + method remaining = 0 + method abort_track = () + method generate_frame = if s#is_ready then s#get_frame else self#empty_frame + end + +let _ = + let return_t = Lang.frame_t (Lang.univ_t ()) Frame.Fields.empty in + Lang.add_operator ~base:Modules.debug "is_ready" ~category:`Input + ~descr: + "A source that always produces an empty frame when the underlying source \ + is not ready, used for testing and debugging." + ~flags:[`Experimental] ~return_t + [("", Lang.source_t return_t, None, None)] + (fun p -> + let s = Lang.to_source (List.assoc "" p) in + new is_ready s) diff --git a/tests/regression/GH4159.liq b/tests/regression/GH4159.liq new file mode 100644 index 0000000000..e17b86607d --- /dev/null +++ b/tests/regression/GH4159.liq @@ -0,0 +1,5 @@ +s = debug.is_ready(sine(duration=0.2)) + +s = source.dynamic(track_sensitive=false, {s}) + +output.dummy(fallible=true, on_stop=test.pass, s) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index e8c347a689..25850015bc 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -735,6 +735,22 @@ (:run_test ../run_test.exe)) (action (run %{run_test} GH4144.liq liquidsoap %{test_liq} GH4144.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + GH4159.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} GH4159.liq liquidsoap %{test_liq} GH4159.liq))) + (rule (alias citest) (package liquidsoap) From 8a0880798a866f99dc995c3c4232bd3c70c9bd89 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 12 Oct 2024 20:26:12 -0500 Subject: [PATCH 051/151] Make pulseaudio input and output resilient to errors. (#4174) --- CHANGES.md | 1 + src/core/io/pulseaudio_io.ml | 155 ++++++++++++++++++++++++++--------- 2 files changed, 119 insertions(+), 37 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 3c24992907..cc939d7349 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -91,6 +91,7 @@ Changed: - Changed the port for the built-in Prometheus exporter to `9599` (#3801). - Set `segments_overheader` in HLS outputs to disable segments cleanup altogether. - Added support for caching LV2 and LADSPA plugins (#3959). +- Pulseaudio input and output now restart on pulseaudio errors (#4174). Fixed: diff --git a/src/core/io/pulseaudio_io.ml b/src/core/io/pulseaudio_io.ml index 70b5bd2691..7cb56d1ce3 100644 --- a/src/core/io/pulseaudio_io.ml +++ b/src/core/io/pulseaudio_io.ml @@ -57,6 +57,9 @@ class virtual base ~self_sync ~client ~device = class output ~infallible ~register_telnet ~start ~on_start ~on_stop p = let client = Lang.to_string (List.assoc "client" p) in let device = Lang.to_string (List.assoc "device" p) in + let retry_delay = Lang.to_float (List.assoc "retry_delay" p) in + let on_error = List.assoc "on_error" p in + let on_error s = ignore (Lang.apply on_error [("", Lang.string s)]) in let name = Printf.sprintf "pulse_out(%s:%s)" client device in let val_source = List.assoc "" p in let samples_per_second = Lazy.force Frame.audio_rate in @@ -70,19 +73,32 @@ class output ~infallible ~register_telnet ~start ~on_start ~on_stop p = ~output_kind:"output.pulseaudio" val_source start val mutable stream = None + val mutable last_try = 0. - method open_device = - let ss = - { - sample_format = Sample_format_float32le; - sample_rate = samples_per_second; - sample_chans = self#audio_channels; - } - in - stream <- - Some - (Pulseaudio.Simple.create ~client_name ~stream_name:self#id ?dev - ~dir:Dir_playback ~sample:ss ()) + method private open_device = + let now = Unix.gettimeofday () in + try + if last_try +. retry_delay < now then ( + last_try <- now; + let ss = + { + sample_format = Sample_format_float32le; + sample_rate = samples_per_second; + sample_chans = self#audio_channels; + } + in + stream <- + Some + (Pulseaudio.Simple.create ~client_name ~stream_name:self#id ?dev + ~dir:Dir_playback ~sample:ss ())) + with exn -> + let bt = Printexc.get_backtrace () in + let error = + Printf.sprintf "Failed to open pulse audio device: %s" + (Printexc.to_string exn) + in + on_error error; + Utils.log_exception ~log:self#log ~bt error method close_device = match stream with @@ -99,15 +115,30 @@ class output ~infallible ~register_telnet ~start ~on_start ~on_stop p = self#open_device method send_frame memo = - let stream = Option.get stream in - let buf = AFrame.pcm memo in - let len = Audio.length buf in - Simple.write stream buf 0 len + if stream = None then self#open_device; + match stream with + | Some stream -> ( + let buf = AFrame.pcm memo in + let len = Audio.length buf in + try Simple.write stream buf 0 len + with exn -> + let bt = Printexc.get_backtrace () in + self#close_device; + let error = + Printf.sprintf "Failed to send pulse audio data: %s" + (Printexc.to_string exn) + in + on_error error; + Utils.log_exception ~log:self#log ~bt error) + | None -> () end class input p = let client = Lang.to_string (List.assoc "client" p) in let device = Lang.to_string (List.assoc "device" p) in + let retry_delay = Lang.to_float (List.assoc "retry_delay" p) in + let on_error = List.assoc "on_error" p in + let on_error s = ignore (Lang.apply on_error [("", Lang.string s)]) in let self_sync = Lang.to_bool (List.assoc "self_sync" p) in let start = Lang.to_bool (List.assoc "start" p) in let fallible = Lang.to_bool (List.assoc "fallible" p) in @@ -133,34 +164,74 @@ class input p = method remaining = -1 method abort_track = () method seek_source = (self :> Source.source) - method private can_generate_frame = active_source#started + + method private can_generate_frame = + match (active_source#started, stream) with + | true, None -> + self#open_device; + stream <> None + | v, _ -> v + + val mutable last_try = 0. method private open_device = - let ss = - { - sample_format = Sample_format_float32le; - sample_rate = samples_per_second; - sample_chans = self#audio_channels; - } - in - stream <- - Some - (Pulseaudio.Simple.create ~client_name ~stream_name:self#id - ~dir:Dir_record ?dev ~sample:ss ()) + let now = Unix.gettimeofday () in + if last_try +. retry_delay < now then ( + last_try <- now; + let ss = + { + sample_format = Sample_format_float32le; + sample_rate = samples_per_second; + sample_chans = self#audio_channels; + } + in + try + stream <- + Some + (Pulseaudio.Simple.create ~client_name ~stream_name:self#id + ~dir:Dir_record ?dev ~sample:ss ()) + with exn when fallible -> + let bt = Printexc.get_backtrace () in + let error = + Printf.sprintf "Error while connecting to pulseaudio: %s" + (Printexc.to_string exn) + in + on_error error; + Utils.log_exception ~log:self#log ~bt error) method private close_device = - Pulseaudio.Simple.free (Option.get stream); - stream <- None + match stream with + | Some device -> + Pulseaudio.Simple.free device; + stream <- None + | None -> () method generate_frame = - let size = Lazy.force Frame.size in - let frame = Frame.create ~length:size self#content_type in - let buf = Content.Audio.get_data (Frame.get frame Frame.Fields.audio) in - let stream = Option.get stream in - Simple.read stream buf 0 (Frame.audio_of_main size); - Frame.set_data frame Frame.Fields.audio Content.Audio.lift_data buf + try + let size = Lazy.force Frame.size in + let frame = Frame.create ~length:size self#content_type in + let buf = Content.Audio.get_data (Frame.get frame Frame.Fields.audio) in + let stream = Option.get stream in + Simple.read stream buf 0 (Frame.audio_of_main size); + Frame.set_data frame Frame.Fields.audio Content.Audio.lift_data buf + with exn -> + let bt = Printexc.get_raw_backtrace () in + if fallible then ( + let error = + Printf.sprintf "Error while reading from pulseaudio: %s" + (Printexc.to_string exn) + in + on_error error; + Utils.log_exception ~log:self#log + ~bt:(Printexc.raw_backtrace_to_string bt) + error; + self#empty_frame) + else Printexc.raise_with_backtrace exn bt end +let on_error = + Lang.eval ~cache:false ~typecheck:false ~stdlib:`Disabled "fun (_) -> ()" + let proto = [ ("client", Lang.string_t, Some (Lang.string "liquidsoap"), None); @@ -168,6 +239,16 @@ let proto = Lang.string_t, Some (Lang.string ""), Some "Device to use. Uses default if set to \"\"." ); + ( "retry_delay", + Lang.float_t, + Some (Lang.float 1.), + Some "When fallible, time to wait before trying to connect again." ); + ( "on_error", + Lang.fun_t [(false, "", Lang.string_t)] Lang.unit_t, + Some on_error, + Some + "Function executed when an operation with the pulseaudio server \ + returns an error." ); ( "self_sync", Lang.bool_t, Some (Lang.bool true), @@ -204,7 +285,7 @@ let _ = (Frame.Fields.make ~audio:(Format_type.audio ()) ()) in Lang.add_operator ~base:Modules.input "pulseaudio" - (Start_stop.active_source_proto ~fallible_opt:(`Yep false) @ proto) + (Start_stop.active_source_proto ~fallible_opt:(`Yep true) @ proto) ~return_t ~category:`Input ~meth:(Start_stop.meth ()) ~descr:"Stream from a pulseaudio input device." (fun p -> new input p) From 03ad0db541f9343aaf91054e8aba20e3b02f1a70 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 12 Oct 2024 20:27:09 -0500 Subject: [PATCH 052/151] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 3455d3bd54..592b8b27d2 100644 --- a/README.md +++ b/README.md @@ -36,7 +36,7 @@ See the instructions [here](https://www.liquidsoap.info/doc.html?path=install.ht Current release status by version: | Branch | Latest release | Supported | Rolling Release | | --------|----------------|-----------|-----------------| -| `2.3.x` | | 🧫 (release in alpha stage) | [2.3.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.3.x) (docker: [savonet/liquidsoap:rolling-release-v2.3.x](https://hub.docker.com/r/savonet/liquidsoap)) | +| `2.3.x` | | 🧫 (release in RC stage) | [2.3.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.3.x) (docker: [savonet/liquidsoap:rolling-release-v2.3.x](https://hub.docker.com/r/savonet/liquidsoap)) | | `2.2.x` | [2.2.5](https://github.com/savonet/liquidsoap/releases/tag/v2.2.5) (docker: [savonet/liquidsoap:v2.2.5](https://hub.docker.com/r/savonet/liquidsoap))| 🌅 (release to be retired soon)| [2.2.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.2.x) (docker: [savonet/liquidsoap:rolling-release-v2.2.x](https://hub.docker.com/r/savonet/liquidsoap)) | | `2.1.x` | [2.1.4](https://github.com/savonet/liquidsoap/releases/tag/v2.1.4) (docker: [savonet/liquidsoap:v2.1.4](https://hub.docker.com/r/savonet/liquidsoap))| ❌ | [2.1.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.1.x) (docker: [savonet/liquidsoap:rolling-release-v2.1.x](https://hub.docker.com/r/savonet/liquidsoap)) | From de7beea49b701072018aec4d4b270652bcb3a475 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 13 Oct 2024 12:08:40 -0500 Subject: [PATCH 053/151] Catch and report exceptions raised when removing inotify handlers. --- src/core/file_watcher.inotify.ml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/core/file_watcher.inotify.ml b/src/core/file_watcher.inotify.ml index cf36f66de0..431644569a 100644 --- a/src/core/file_watcher.inotify.ml +++ b/src/core/file_watcher.inotify.ml @@ -37,6 +37,7 @@ type watch = let fd = ref (None : Unix.file_descr option) let handlers = ref [] let m = Mutex.create () +let log = Log.make ["inotify"] let rec watchdog () = let fd = Option.get !fd in @@ -77,7 +78,12 @@ let watch : watch = handlers := (wd, f) :: !handlers; let unwatch = Mutex_utils.mutexify m (fun () -> - Inotify.rm_watch fd wd; + (try Inotify.rm_watch fd wd + with exn -> + let bt = Printexc.get_backtrace () in + Utils.log_exception ~log:self#log ~bt + (Printf.sprintf "Error whole removing file watch handler: %s" + (Printexc.to_string exn))); handlers := List.remove_assoc wd !handlers) in unwatch) From dcfd1f2f563d640846f3bf024e47a92612baa454 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 13 Oct 2024 18:31:43 -0500 Subject: [PATCH 054/151] Add liq_disable_autocue to the list of metadata used to disable autocue. --- src/libs/autocue.liq | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index 065cfc32b8..a51ad42b66 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -54,7 +54,8 @@ let settings.autocue.internal.metadata_override = "liq_fade_in", "liq_fade_in_delay", "liq_fade_out", - "liq_fade_out_delay" + "liq_fade_out_delay", + "liq_disable_autocue" ] ) From c656a02be7e1de77affe7b16ae75637a156069ef Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 13 Oct 2024 18:46:19 -0500 Subject: [PATCH 055/151] Fix this. --- src/core/file_watcher.inotify.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/file_watcher.inotify.ml b/src/core/file_watcher.inotify.ml index 431644569a..5e81b9b831 100644 --- a/src/core/file_watcher.inotify.ml +++ b/src/core/file_watcher.inotify.ml @@ -81,7 +81,7 @@ let watch : watch = (try Inotify.rm_watch fd wd with exn -> let bt = Printexc.get_backtrace () in - Utils.log_exception ~log:self#log ~bt + Utils.log_exception ~log ~bt (Printf.sprintf "Error whole removing file watch handler: %s" (Printexc.to_string exn))); handlers := List.remove_assoc wd !handlers) From 49f617fba09480dee49c1e6fd7b47d7da53fa497 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 13 Oct 2024 19:32:57 -0500 Subject: [PATCH 056/151] Allow nested static request (#4175) --- CHANGES.md | 3 ++ doc/content/migrating.md | 16 +++++++++++ src/core/builtins/builtins_resolvers.ml | 15 ++++++---- src/core/doc.ml | 21 ++++++++++++++ src/core/lang.ml | 3 +- src/core/lang.mli | 2 +- src/core/protocols/annotate.ml | 7 ++++- src/core/protocols/mpd.ml | 4 ++- src/core/request.ml | 6 ++-- src/core/request.mli | 2 +- src/lang/doc.ml | 27 ------------------ src/libs/protocols.liq | 37 ++++++++++++++++++------- src/runtime/main.ml | 1 - 13 files changed, 92 insertions(+), 52 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index cc939d7349..26ac685fca 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -85,6 +85,9 @@ Changed: `nan != x` is always `true`. Use `float.is_nan` to test if a float is `nan`. - BREAKING: `replaygain` no longer takes `ebu_r128` parameter (#3438). - BREAKING: assume `replaygain_track_gain` always stores volume in _dB_ (#3438). +- BREAKING: protocols can now check for nested static uri. Typically, this means + that requests for an uri of the form: `annotate:key="value",...:/path/to/file.mp3` + is now considered infallible if `/path/to/file.mp3` can be decoded. - Added `parents` option of `file.mkdir` (#3600, #3601). - Added `forced_major_collections` record field to the result of `runtime.gc.stat()` and `runtime.gc.quick_stat()` (#3783). diff --git a/doc/content/migrating.md b/doc/content/migrating.md index 6f6aca2361..3a99da33b5 100644 --- a/doc/content/migrating.md +++ b/doc/content/migrating.md @@ -120,6 +120,22 @@ for more details. However, EBU R128 data is now extracted directly from metadata when available. So `replaygain` cannot control the gain type via this parameter anymore. +### Static requests + +Static requests detection can now work with nested requests. + +Typically, a request for this URI: `annotate:key="value",...:/path/to/file.mp3` will be +considered static if `/path/to/file.mp3` can be decoded. + +Practically, this means that more source will now be considered infallible, for instance +a `single` using the above uri. + +In most cases, this should improve the user experience when building new scripts and streaming +systems. + +In rare cases where you actually wanted a fallible source, you can still pass `fallible=true` to e.g. +the `single` operator or use the `fallible:` protocol. + ### String functions Some string functions have been updated to account for string encoding. In particular, `string.length` and `string.sub` now assume that their diff --git a/src/core/builtins/builtins_resolvers.ml b/src/core/builtins/builtins_resolvers.ml index c1af3259e0..5499a047a5 100644 --- a/src/core/builtins/builtins_resolvers.ml +++ b/src/core/builtins/builtins_resolvers.ml @@ -133,6 +133,9 @@ let _ = { Playlist_parser.strict; Playlist_parser.parser = fn }; Lang.unit) +let default_static = + Lang.eval ~cache:false ~typecheck:false ~stdlib:`Disabled "fun (_) -> false" + let _ = let log_p = [("", "", None)] in let log_t = Lang.fun_t [(false, "", Lang.string_t)] Lang.unit_t in @@ -153,11 +156,12 @@ let _ = Some (Lang.bool false), Some "if true, file is removed when it is finished." ); ( "static", - Lang.bool_t, - Some (Lang.bool false), + Lang.fun_t [(false, "", Lang.string_t)] Lang.bool_t, + Some default_static, Some - "if true, then requests can be resolved once and for all. Typically, \ - static protocols can be used to create infallible sources." ); + "When given an uri for the protocol, if it returns `true`, then \ + requests can be resolved once and for all. Typically, static \ + protocols can be used to create infallible sources." ); ( "syntax", Lang.string_t, Some (Lang.string "Undocumented"), @@ -185,7 +189,8 @@ let _ = let name = Lang.to_string (Lang.assoc "" 1 p) in let f = Lang.assoc "" 2 p in let temporary = Lang.to_bool (List.assoc "temporary" p) in - let static = Lang.to_bool (List.assoc "static" p) in + let static = List.assoc "static" p in + let static s = Lang.to_bool (Lang.apply static [("", Lang.string s)]) in let doc = Lang.to_string (List.assoc "doc" p) in let syntax = Lang.to_string (List.assoc "syntax" p) in Lang.add_protocol ~syntax ~doc ~static name (fun arg ~log timeout -> diff --git a/src/core/doc.ml b/src/core/doc.ml index 9d9afa045d..7604a93890 100644 --- a/src/core/doc.ml +++ b/src/core/doc.ml @@ -1 +1,22 @@ include Liquidsoap_lang.Doc + +(** Documentation for protocols. *) +module Protocol = struct + type t = { name : string; description : string; syntax : string } + + let db = ref [] + + let add ~name ~doc ~syntax = + let p = { name; description = doc; syntax } in + db := p :: !db + + let db () = List.sort compare !db + let count () = db () |> List.length + + let print_md print = + List.iter + (fun p -> + Printf.ksprintf print "### %s\n\n%s\n\nThe syntax is `%s`.\n\n" p.name + p.description p.syntax) + (db ()) +end diff --git a/src/core/lang.ml b/src/core/lang.ml index a5904d4a60..cca49f0597 100644 --- a/src/core/lang.ml +++ b/src/core/lang.ml @@ -1,7 +1,6 @@ include Liquidsoap_lang.Lang include Lang_source include Lang_encoder.L -module Doc = Liquidsoap_lang.Doc module Flags = Liquidsoap_lang.Flags module Http = Liq_http @@ -11,7 +10,7 @@ let () = Hooks_implementations.register () (** Helpers for defining protocols. *) let add_protocol ~syntax ~doc ~static name resolver = - Doc.Protocol.add ~name ~doc ~syntax ~static; + Doc.Protocol.add ~name ~doc ~syntax; let spec = { Request.static; resolve = resolver } in Plug.register Request.protocols ~doc name spec diff --git a/src/core/lang.mli b/src/core/lang.mli index dfcf39091e..b933b25e1f 100644 --- a/src/core/lang.mli +++ b/src/core/lang.mli @@ -62,7 +62,7 @@ val apply : ?pos:Liquidsoap_lang.Pos.t list -> value -> env -> value val add_protocol : syntax:string -> doc:string -> - static:bool -> + static:(string -> bool) -> string -> Request.resolver -> unit diff --git a/src/core/protocols/annotate.ml b/src/core/protocols/annotate.ml index d5aafc5aca..0630dacd11 100644 --- a/src/core/protocols/annotate.ml +++ b/src/core/protocols/annotate.ml @@ -66,5 +66,10 @@ let annotate s ~log _ = let () = Lang.add_protocol ~doc:"Add metadata to a request" - ~syntax:"annotate:key=\"val\",key2=\"val2\",...:uri" ~static:false + ~syntax:"annotate:key=\"val\",key2=\"val2\",...:uri" + ~static:(fun uri -> + try + let _, uri = parse uri in + Request.is_static uri + with _ -> false) "annotate" annotate diff --git a/src/core/protocols/mpd.ml b/src/core/protocols/mpd.ml index c4d6ea7444..fae9a6e60e 100644 --- a/src/core/protocols/mpd.ml +++ b/src/core/protocols/mpd.ml @@ -146,4 +146,6 @@ let mpd s ~log _ = let () = Lang.add_protocol ~doc:"Finds all files with a tag equal to a given value using mpd." - ~syntax:"mpd:tag=value" ~static:false "mpd" mpd + ~syntax:"mpd:tag=value" + ~static:(fun _ -> false) + "mpd" mpd diff --git a/src/core/request.ml b/src/core/request.ml index 11407289be..e6c6c5cd31 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -610,7 +610,7 @@ let get_decoder ~ctype r = (** Plugins registration. *) type resolver = string -> log:(string -> unit) -> float -> indicator option -type protocol = { resolve : resolver; static : bool } +type protocol = { resolve : resolver; static : string -> bool } let protocols_doc = "Methods to get a file. They are the first part of URIs: 'protocol:args'." @@ -621,9 +621,9 @@ let is_static s = if file_exists (home_unrelate s) then true else ( match parse_uri s with - | Some (proto, _) -> ( + | Some (proto, uri) -> ( match Plug.get protocols proto with - | Some handler -> handler.static + | Some handler -> handler.static uri | None -> false) | None -> false) diff --git a/src/core/request.mli b/src/core/request.mli index f5052c6558..80a8bd68b5 100644 --- a/src/core/request.mli +++ b/src/core/request.mli @@ -100,7 +100,7 @@ val from_id : int -> t option type resolver = string -> log:(string -> unit) -> float -> indicator option (** A protocol, which can resolve associated URIs. *) -type protocol = { resolve : resolver; static : bool } +type protocol = { resolve : resolver; static : string -> bool } (** A static request [r] is such that every resolving leads to the same file. Sometimes, it allows removing useless destroy/create/resolve. *) diff --git a/src/lang/doc.ml b/src/lang/doc.ml index 90d23ded51..5e3588cbd5 100644 --- a/src/lang/doc.ml +++ b/src/lang/doc.ml @@ -62,33 +62,6 @@ module Plug = struct let print_string = print_md end -(** Documentation for protocols. *) -module Protocol = struct - type t = { - name : string; - description : string; - syntax : string; - static : bool; - } - - let db = ref [] - - let add ~name ~doc ~syntax ~static = - let p = { name; description = doc; syntax; static } in - db := p :: !db - - let db () = List.sort compare !db - let count () = db () |> List.length - - let print_md print = - List.iter - (fun p -> - let static = if p.static then " This protocol is static." else "" in - Printf.ksprintf print "### %s\n\n%s\n\nThe syntax is `%s`.%s\n\n" p.name - p.description p.syntax static) - (db ()) -end - (** Documenentation for values. *) module Value = struct (** Documentation flags. *) diff --git a/src/libs/protocols.liq b/src/libs/protocols.liq index 71d51c4990..afa8d7b1c4 100644 --- a/src/libs/protocols.liq +++ b/src/libs/protocols.liq @@ -388,6 +388,23 @@ protocol.add( syntax="tmp:uri" ) +# Register fallible +# @flag hidden +def protocol.fallible(~rlog=_, ~maxtime=_, arg) = + arg +end + +protocol.add( + "fallible", + protocol.fallible, + doc= + "Mark the given uri as being fallible. This can be used to prevent a request \ + or source from being resolved once and for all and considered infallible \ + for the duration of the script, typically when debugging.", + static=fun (_) -> false, + syntax="fallible:uri" +) + let settings.protocol.ffmpeg = settings.make.protocol("FFmpeg") let settings.protocol.ffmpeg.path = settings.make( @@ -651,7 +668,7 @@ def protocol.stereo(~rlog=_, ~maxtime=_, arg) = end protocol.add( - static=true, + static=fun (_) -> true, temporary=true, "stereo", protocol.stereo, @@ -671,7 +688,7 @@ def protocol.copy(~rlog=_, ~maxtime=_, arg) = end protocol.add( - static=true, + static=fun (_) -> true, "copy", protocol.copy, doc= @@ -699,7 +716,7 @@ def protocol.text2wave(~rlog=_, ~maxtime=_, arg) = end protocol.add( - static=true, + static=fun (_) -> true, "text2wave", protocol.text2wave, doc= @@ -736,7 +753,7 @@ def protocol.pico2wave(~rlog=_, ~maxtime=_, arg) = end protocol.add( - static=true, + static=fun (_) -> true, "pico2wave", protocol.pico2wave, doc= @@ -781,7 +798,7 @@ def protocol.gtts(~rlog=_, ~maxtime=_, arg) = end protocol.add( - static=true, + static=fun (_) -> true, "gtts", protocol.gtts, doc= @@ -819,7 +836,7 @@ def protocol.macos_say(~rlog=_, ~maxtime=_, arg) = end protocol.add( - static=true, + static=fun (_) -> true, "macos_say", protocol.macos_say, doc= @@ -846,7 +863,7 @@ def protocol.say(~rlog=_, ~maxtime=_, arg) = end protocol.add( - static=true, + static=fun (_) -> true, "say", protocol.say, doc= @@ -993,7 +1010,7 @@ def polly_protocol(~rlog=_, ~maxtime=_, text) = end protocol.add( - static=true, + static=fun (_) -> true, "polly", polly_protocol, doc= @@ -1070,7 +1087,7 @@ def synth_protocol(~rlog=_, ~maxtime=_, text) = end protocol.add( - static=true, + static=fun (_) -> true, temporary=true, "synth", synth_protocol, @@ -1101,7 +1118,7 @@ def file_protocol(~rlog=_, ~maxtime=_, arg) = end protocol.add( - static=true, + static=fun (_) -> true, temporary=false, "file", file_protocol, diff --git a/src/runtime/main.ml b/src/runtime/main.ml index a376d47205..4691f0c774 100644 --- a/src/runtime/main.ml +++ b/src/runtime/main.ml @@ -21,7 +21,6 @@ *****************************************************************************) module Runtime = Liquidsoap_lang.Runtime -module Doc = Liquidsoap_lang.Doc module Environment = Liquidsoap_lang.Environment module Profiler = Liquidsoap_lang.Profiler module Queue = Liquidsoap_lang.Queues.Queue From 94ba8be35f7f754de2f25af3472532d9d1e819c6 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 14 Oct 2024 09:26:34 -0500 Subject: [PATCH 057/151] Fix logic. --- src/core/io/pulseaudio_io.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/io/pulseaudio_io.ml b/src/core/io/pulseaudio_io.ml index 7cb56d1ce3..76da06c614 100644 --- a/src/core/io/pulseaudio_io.ml +++ b/src/core/io/pulseaudio_io.ml @@ -216,6 +216,7 @@ class input p = Frame.set_data frame Frame.Fields.audio Content.Audio.lift_data buf with exn -> let bt = Printexc.get_raw_backtrace () in + self#close_device; if fallible then ( let error = Printf.sprintf "Error while reading from pulseaudio: %s" From 61d12cd554978af1bc13544806bd5d8ac396264b Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 14 Oct 2024 09:31:40 -0500 Subject: [PATCH 058/151] Also mark last try when closing on error. --- src/core/io/pulseaudio_io.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/io/pulseaudio_io.ml b/src/core/io/pulseaudio_io.ml index 76da06c614..5348aa87af 100644 --- a/src/core/io/pulseaudio_io.ml +++ b/src/core/io/pulseaudio_io.ml @@ -124,6 +124,7 @@ class output ~infallible ~register_telnet ~start ~on_start ~on_stop p = with exn -> let bt = Printexc.get_backtrace () in self#close_device; + last_try <- Unix.gettimeofday (); let error = Printf.sprintf "Failed to send pulse audio data: %s" (Printexc.to_string exn) @@ -217,6 +218,7 @@ class input p = with exn -> let bt = Printexc.get_raw_backtrace () in self#close_device; + last_try <- Unix.gettimeofday (); if fallible then ( let error = Printf.sprintf "Error while reading from pulseaudio: %s" From fb7d36d32529b18d6710197ac484f5c30b1ddfe4 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 14 Oct 2024 10:42:42 -0500 Subject: [PATCH 059/151] Add debugging log. --- src/core/source.ml | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/core/source.ml b/src/core/source.ml index d741b6fab5..d6c681ff01 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -640,7 +640,12 @@ class virtual generate_from_multiple_sources ~merge ~track_sensitive () = | Some s when last_source == s -> let remainder = s#get_partial_frame (fun frame -> - assert (last_chunk_pos < Frame.position frame); + if Frame.position frame <= last_chunk_pos then ( + self#log#critical + "Source %s was re-selected but did not produce \ + enough data: %d - assert s#is_ready; + if not s#is_ready then ( + self#log#critical "Underlying source %s is not ready!" s#id; + assert false); let new_track = s#get_partial_frame (fun frame -> match self#split_frame frame with From abb07d5a21050a75b1c71af412014dd9afaedf42 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 14 Oct 2024 14:37:06 -0500 Subject: [PATCH 060/151] Better. --- src/core/io/pulseaudio_io.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/io/pulseaudio_io.ml b/src/core/io/pulseaudio_io.ml index 5348aa87af..f2ee387e52 100644 --- a/src/core/io/pulseaudio_io.ml +++ b/src/core/io/pulseaudio_io.ml @@ -123,8 +123,8 @@ class output ~infallible ~register_telnet ~start ~on_start ~on_stop p = try Simple.write stream buf 0 len with exn -> let bt = Printexc.get_backtrace () in - self#close_device; last_try <- Unix.gettimeofday (); + self#close_device; let error = Printf.sprintf "Failed to send pulse audio data: %s" (Printexc.to_string exn) @@ -217,8 +217,8 @@ class input p = Frame.set_data frame Frame.Fields.audio Content.Audio.lift_data buf with exn -> let bt = Printexc.get_raw_backtrace () in - self#close_device; last_try <- Unix.gettimeofday (); + self#close_device; if fallible then ( let error = Printf.sprintf "Error while reading from pulseaudio: %s" From 4d1c2ea0b44c1a780d33c4a4db3ad418879482ec Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 15 Oct 2024 14:58:00 -0500 Subject: [PATCH 061/151] Check if before source is ready in crossfade before returning it. (#4177) --- src/core/operators/cross.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/operators/cross.ml b/src/core/operators/cross.ml index 44082dea5f..21344a0fa1 100644 --- a/src/core/operators/cross.ml +++ b/src/core/operators/cross.ml @@ -276,12 +276,12 @@ class cross val_source ~end_duration_getter ~override_end_duration self#prepare_source before; status <- `Before (before :> Source.source); self#buffer_before ~is_first:true (); - before + if before#is_ready then Some before else None method private get_source ~reselect () = let reselect = match reselect with `Force -> `Ok | _ -> reselect in match status with - | `Idle when source#is_ready -> Some self#prepare_before + | `Idle when source#is_ready -> self#prepare_before | `Idle -> None | `Before _ -> ( self#buffer_before ~is_first:false (); @@ -294,7 +294,7 @@ class cross val_source ~end_duration_getter ~override_end_duration | `After after_source -> Some after_source) | `After after_source when self#can_reselect ~reselect after_source -> Some after_source - | `After _ -> Some self#prepare_before + | `After _ -> self#prepare_before method private buffer_before ~is_first () = if Generator.length gen_before < end_main_duration && source#is_ready then ( From d4a164e3d71e806c263945a66795703624145d90 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 16 Oct 2024 08:44:03 -0500 Subject: [PATCH 062/151] Pulseaudio IO: use stream to control latency, not device! --- src/core/io/pulseaudio_io.ml | 37 ++++++++++++++++++++++++++---------- 1 file changed, 27 insertions(+), 10 deletions(-) diff --git a/src/core/io/pulseaudio_io.ml b/src/core/io/pulseaudio_io.ml index f2ee387e52..2d5a45d027 100644 --- a/src/core/io/pulseaudio_io.ml +++ b/src/core/io/pulseaudio_io.ml @@ -42,25 +42,37 @@ let error_translator e = let () = Printexc.register_printer error_translator class virtual base ~self_sync ~client ~device = - let device = if device = "" then None else Some device in object val client_name = client val dev = device + val mutable stream = None method virtual log : Log.t method self_sync : Clock.self_sync = if self_sync then - (`Dynamic, if dev <> None then Some sync_source else None) + (`Dynamic, if stream <> None then Some sync_source else None) else (`Static, None) end +let log = Log.make ["pulseaudio"] + class output ~infallible ~register_telnet ~start ~on_start ~on_stop p = let client = Lang.to_string (List.assoc "client" p) in - let device = Lang.to_string (List.assoc "device" p) in + let device = Lang.to_valued_option Lang.to_string (List.assoc "device" p) in + let device = + if device = Some "" then ( + log#important + "Empty device name \"\" is deprecated! Please use `null()` instead.."; + None) + else device + in let retry_delay = Lang.to_float (List.assoc "retry_delay" p) in let on_error = List.assoc "on_error" p in let on_error s = ignore (Lang.apply on_error [("", Lang.string s)]) in - let name = Printf.sprintf "pulse_out(%s:%s)" client device in + let name = + Printf.sprintf "pulse_out(%s:%s)" client + (match device with None -> "(default)" | Some s -> s) + in let val_source = List.assoc "" p in let samples_per_second = Lazy.force Frame.audio_rate in let self_sync = Lang.to_bool (List.assoc "self_sync" p) in @@ -72,7 +84,6 @@ class output ~infallible ~register_telnet ~start ~on_start ~on_stop p = ~infallible ~register_telnet ~on_stop ~on_start ~name ~output_kind:"output.pulseaudio" val_source start - val mutable stream = None val mutable last_try = 0. method private open_device = @@ -136,7 +147,14 @@ class output ~infallible ~register_telnet ~start ~on_start ~on_stop p = class input p = let client = Lang.to_string (List.assoc "client" p) in - let device = Lang.to_string (List.assoc "device" p) in + let device = Lang.to_valued_option Lang.to_string (List.assoc "device" p) in + let device = + if device = Some "" then ( + log#important + "Empty device name \"\" is deprecated! Please use `null()` instead.."; + None) + else device + in let retry_delay = Lang.to_float (List.assoc "retry_delay" p) in let on_error = List.assoc "on_error" p in let on_error s = ignore (Lang.apply on_error [("", Lang.string s)]) in @@ -161,7 +179,6 @@ class input p = inherit base ~self_sync ~client ~device method private start = self#open_device method private stop = self#close_device - val mutable stream = None method remaining = -1 method abort_track = () method seek_source = (self :> Source.source) @@ -239,9 +256,9 @@ let proto = [ ("client", Lang.string_t, Some (Lang.string "liquidsoap"), None); ( "device", - Lang.string_t, - Some (Lang.string ""), - Some "Device to use. Uses default if set to \"\"." ); + Lang.nullable_t Lang.string_t, + Some Lang.null, + Some "Device to use. Uses default if set to `null`." ); ( "retry_delay", Lang.float_t, Some (Lang.float 1.), From 9ab21acd37100bad577bf41f5d40248f69bb32a9 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 16 Oct 2024 09:07:24 -0500 Subject: [PATCH 063/151] Don't run automatic autocue when override metadata is detected. --- src/libs/autocue.liq | 136 ++++++++++++++++++++++++------------------- 1 file changed, 76 insertions(+), 60 deletions(-) diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index a51ad42b66..d6763ef501 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -808,6 +808,7 @@ let file.autocue = () def file.autocue.metadata(~metadata, uri) = preferred_implementation = settings.autocue.preferred() implementations = settings.autocue.implementations() + let (implementation_name, implementation) = if list.assoc.mem(preferred_implementation, implementations) @@ -974,77 +975,92 @@ def enable_autocue_metadata() = if settings.request.prefetch() == 1 then settings.request.prefetch := 2 end def autocue_metadata(~metadata, fname) = - autocue_metadata = file.autocue.metadata(metadata=metadata, fname) - - all_amplify = [...settings.autocue.amplify_aliases(), "liq_amplify"] - user_supplied_amplify = - list.filter_map( - fun (el) -> - if list.mem(fst(el), all_amplify) then snd(el) else null() end, - metadata - ) - user_supplied_amplify_labels = - string.concat( - separator= - ", ", - user_supplied_amplify + metadata_overrides = settings.autocue.internal.metadata_override() + + if + list.exists(fun (el) -> list.mem(fst(el), metadata_overrides), metadata) + then + log( + level=2, + label="autocue.metadata", + "Override metadata detected for #{fname}, disabling autocue!" ) + [] + else + autocue_metadata = file.autocue.metadata(metadata=metadata, fname) - autocue_metadata = - if - settings.autocue.amplify_behavior() == "ignore" - then - [...list.assoc.remove("liq_amplify", autocue_metadata)] - else + all_amplify = [...settings.autocue.amplify_aliases(), "liq_amplify"] + + user_supplied_amplify = + list.filter_map( + fun (el) -> + if list.mem(fst(el), all_amplify) then snd(el) else null() end, + metadata + ) + + user_supplied_amplify_labels = + string.concat( + separator= + ", ", + user_supplied_amplify + ) + + autocue_metadata = if - user_supplied_amplify != [] + settings.autocue.amplify_behavior() == "ignore" then + [...list.assoc.remove("liq_amplify", autocue_metadata)] + else if - settings.autocue.amplify_behavior() == "keep" - then - log( - level=3, - label="autocue.metadata", - "User-supplied amplify metadata detected: #{ - user_supplied_amplify_labels - }, keeping user-provided data." - ) - list.assoc.remove("liq_amplify", autocue_metadata) - elsif - settings.autocue.amplify_behavior() == "override" + user_supplied_amplify != [] then - log( - level=3, - label="autocue.metadata", - "User-supplied amplify metadata detected: #{ - user_supplied_amplify_labels - }, overriding with autocue data." - ) - [ - ...autocue_metadata, - # This replaces all user-provided tags with the value returned by - # the autocue implementation. - ...list.map( - fun (lbl) -> (lbl, autocue_metadata["liq_amplify"]), - user_supplied_amplify + if + settings.autocue.amplify_behavior() == "keep" + then + log( + level=3, + label="autocue.metadata", + "User-supplied amplify metadata detected: #{ + user_supplied_amplify_labels + }, keeping user-provided data." + ) + list.assoc.remove("liq_amplify", autocue_metadata) + elsif + settings.autocue.amplify_behavior() == "override" + then + log( + level=3, + label="autocue.metadata", + "User-supplied amplify metadata detected: #{ + user_supplied_amplify_labels + }, overriding with autocue data." ) - ] + [ + ...autocue_metadata, + # This replaces all user-provided tags with the value returned by + # the autocue implementation. + ...list.map( + fun (lbl) -> (lbl, autocue_metadata["liq_amplify"]), + user_supplied_amplify + ) + ] + else + log( + level=2, + label="autocue.metadata", + "Invalid value for `settings.autocue.amplify_behavior`: #{ + settings.autocue.amplify_behavior() + }" + ) + autocue_metadata + end else - log( - level=2, - label="autocue.metadata", - "Invalid value for `settings.autocue.amplify_behavior`: #{ - settings.autocue.amplify_behavior() - }" - ) autocue_metadata end - else - autocue_metadata end - end - log(level=4, label="autocue.metadata", "#{autocue_metadata}") - autocue_metadata + log(level=4, label="autocue.metadata", "#{autocue_metadata}") + autocue_metadata + end end decoder.metadata.add( priority=settings.autocue.metadata.priority, "autocue", autocue_metadata From abbfca5728ea21409954df6d1be57581829e791d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 16 Oct 2024 10:23:54 -0500 Subject: [PATCH 064/151] Use gettimeofday. --- src/core/request.ml | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/core/request.ml b/src/core/request.ml index e6c6c5cd31..3b5874dce1 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -83,7 +83,7 @@ type metadata_resolver = { } type indicator = { uri : string; temporary : bool; metadata : Frame.metadata } -type resolving = { until : float; pending : (Condition.t * Mutex.t) list } +type resolving = { since : float; pending : (Condition.t * Mutex.t) list } type status = [ `Idle | `Resolving of resolving | `Ready | `Destroyed | `Failed ] type decoder = string * (unit -> Decoder.file_decoder_ops) type on_air = { source : Source.source; timestamp : float } @@ -251,9 +251,9 @@ let add_root_metadata t m = in Frame.Metadata.add "on_air_timestamp" (Printf.sprintf "%.02f" d) m | _, `Idle -> Frame.Metadata.add "status" "idle" m - | _, `Resolving { until } -> + | _, `Resolving { since } -> let m = - Frame.Metadata.add "resolving" (pretty_date (Unix.localtime until)) m + Frame.Metadata.add "resolving" (pretty_date (Unix.localtime since)) m in Frame.Metadata.add "status" "resolving" m | _, `Ready -> Frame.Metadata.add "status" "ready" m @@ -272,7 +272,7 @@ let metadata t = add_root_metadata t (plain_metadata t) let add_log t i = t.logger#info "%s" i; - Queue.push t.log (Unix.localtime (Unix.time ()), i) + Queue.push t.log (Unix.localtime (Unix.gettimeofday ()), i) (* Indicator tree management *) @@ -639,11 +639,12 @@ let () = let resolve_req t timeout = log#debug "Resolving request %s." (string_of_indicators t); - Atomic.set t.status (`Resolving { until = Unix.time (); pending = [] }); - let maxtime = Unix.time () +. timeout in + let since = Unix.gettimeofday () in + Atomic.set t.status (`Resolving { since; pending = [] }); + let maxtime = since +. timeout in let rec resolve i = if Atomic.get should_fail then raise No_indicator; - let timeleft = maxtime -. Unix.time () in + let timeleft = maxtime -. Unix.gettimeofday () in if timeleft <= 0. then ( add_log t "Global timeout."; raise ExnTimeout); @@ -702,7 +703,7 @@ let resolve_req t timeout = `Failed in log#debug "Resolved to %s." (string_of_indicators t); - let excess = Unix.time () -. maxtime in + let excess = Unix.gettimeofday () -. maxtime in if excess > 0. then log#severe "Time limit exceeded by %.2f secs!" excess; let status = if result <> `Resolved then `Failed else `Ready in (match Atomic.exchange t.status status with From 9ed9408a523ed7b1dfe419858e31660ca119a7a7 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 16 Oct 2024 10:38:28 -0500 Subject: [PATCH 065/151] Remove log. --- src/core/sources/request_dynamic.ml | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml index 5c50398756..a628af35a2 100644 --- a/src/core/sources/request_dynamic.ml +++ b/src/core/sources/request_dynamic.ml @@ -92,9 +92,7 @@ class dynamic ~priority ~retry_delay ~available (f : Lang.value) prefetch assert (self#current = None); try match self#get_next_file with - | `Retry -> - self#log#debug "Failed to prepare track: no file."; - false + | `Empty -> false | `Request req when Request.resolved req && Request.has_decoder ~ctype:self#content_type req -> @@ -323,9 +321,7 @@ class dynamic ~priority ~retry_delay ~available (f : Lang.value) prefetch (** Provide the unqueued [super] with resolved requests. *) method private get_next_file = match Queue.pop_opt retrieved with - | None -> - self#log#debug "Queue is empty!"; - `Retry + | None -> `Empty | Some r -> self#log#info "Remaining %d requests" self#queue_size; `Request r.request From 3cd23a16970b8de85c31b13435a375ecd9f29d20 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 16 Oct 2024 13:50:34 -0500 Subject: [PATCH 066/151] Better logging and doc. --- src/core/request.ml | 4 +++- src/core/sources/request_dynamic.ml | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/request.ml b/src/core/request.ml index 3b5874dce1..b2d9b0dc72 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -704,7 +704,9 @@ let resolve_req t timeout = in log#debug "Resolved to %s." (string_of_indicators t); let excess = Unix.gettimeofday () -. maxtime in - if excess > 0. then log#severe "Time limit exceeded by %.2f secs!" excess; + if excess > 0. then + log#severe "Time limit exceeded by %.2f secs (timeout: %.2f)!" excess + timeout; let status = if result <> `Resolved then `Failed else `Ready in (match Atomic.exchange t.status status with | `Resolving { pending } -> diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml index a628af35a2..676f94e0f5 100644 --- a/src/core/sources/request_dynamic.ml +++ b/src/core/sources/request_dynamic.ml @@ -357,7 +357,7 @@ let _ = ( "timeout", Lang.float_t, Some (Lang.float 20.), - Some "Timeout (in sec.) for a single download." ); + Some "Timeout (in sec.) to resolve the request." ); ] ~meth: [ From 35b0ae1c09870d57cc3c46864b66c1d1af2a5d6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=BCr=C5=9Fat=20Akta=C5=9F?= Date: Fri, 18 Oct 2024 19:48:45 +0300 Subject: [PATCH 067/151] Introducing Liquidsoap Guru on Gurubase.io (#4178) --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 592b8b27d2..9cc69a5c8c 100644 --- a/README.md +++ b/README.md @@ -16,6 +16,7 @@ Copyright 2003-2024 Savonet team [![GitHub release](https://img.shields.io/github/release/savonet/liquidsoap.svg)](https://GitHub.com/savonet/liquidsoap/releases/) [![Install with Opam!](https://img.shields.io/badge/Install%20with-Opam-1abc9c.svg)](http://opam.ocaml.org/packages/liquidsoap/) [![Chat on Discord!](https://img.shields.io/badge/Chat%20on-Discord-5865f2.svg)](http://chat.liquidsoap.info/) +[![](https://img.shields.io/badge/Gurubase-Ask%20Liquidsoap%20Guru-006BFF)](https://gurubase.io/g/liquidsoap) | | | | ------------------------- | ----------------------------------------------------------------------- | From 3d2cb3bde68175730da8bed413254a81e079bfcc Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 20 Oct 2024 13:34:17 -0500 Subject: [PATCH 068/151] Better doc. --- src/libs/playlist.liq | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq index 2117b7ed90..a52141d152 100644 --- a/src/libs/playlist.liq +++ b/src/libs/playlist.liq @@ -190,7 +190,7 @@ let stdlib_native = native # @param ~on_done Function executed when the playlist is finished. # @param ~max_fail When this number of requests fail to resolve, the whole playlists is considered as failed and `on_fail` is called. # @param ~on_fail Function executed when too many requests failed and returning the contents of a fixed playlist. -# @param ~timeout Timeout (in sec.) for a single download. +# @param ~timeout Timeout (in sec.) to resolve the request. # @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. # @param ~cue_out_metadata Metadata for cue out points. Disabled if `null`. # @param playlist Playlist. @@ -463,7 +463,7 @@ end # @param ~reload_mode Unit of the reload parameter, either "never" (never reload \ # the playlist), "rounds", "seconds" or "watch" (reload the file whenever it is \ # changed). -# @param ~timeout Timeout (in sec.) for a single download. +# @param ~timeout Timeout (in sec.) to resolve the request. # @param ~thread_queue Queue used to resolve requests. # @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. # @param ~cue_out_metadata Metadata for cue out points. Disabled if `null`. From 72e8c6b33975f0a1eadd997a417cb2193673502e Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 20 Oct 2024 17:50:04 -0500 Subject: [PATCH 069/151] Prevent initializing stereotool with two different libraries. (#4182) --- src/core/operators/stereotool_op.ml | 16 ++++++++++++---- src/stereotool/stereotool.ml | 6 ++++++ src/stereotool/stereotool.mli | 1 + 3 files changed, 19 insertions(+), 4 deletions(-) diff --git a/src/core/operators/stereotool_op.ml b/src/core/operators/stereotool_op.ml index 98c2257184..9f1185e8bf 100644 --- a/src/core/operators/stereotool_op.ml +++ b/src/core/operators/stereotool_op.ml @@ -171,10 +171,18 @@ let _ = let preset = Lang.to_valued_option Lang.to_string preset_val in let handler = let library = Utils.check_readable ~pos:(Lang.pos p) library in - try Stereotool.init ?license_key ~filename:library () - with Stereotool.Library_not_found -> - Runtime_error.raise ~pos:(Lang.pos p) - ~message:"Invalid stereotool library" "invalid" + try Stereotool.init ?license_key ~filename:library () with + | Stereotool.Library_not_found -> + Runtime_error.raise ~pos:(Lang.pos p) + ~message:"Invalid stereotool library" "invalid" + | Stereotool.Library_initialized f -> + Runtime_error.raise ~pos:(Lang.pos p) + ~message: + (Printf.sprintf + "Stereotool already initialized with a different library: \ + %s" + (Lang_string.quote_string f)) + "invalid" in (match preset with | None -> () diff --git a/src/stereotool/stereotool.ml b/src/stereotool/stereotool.ml index 9cd5e4a9b9..f9dff25bc3 100644 --- a/src/stereotool/stereotool.ml +++ b/src/stereotool/stereotool.ml @@ -10,6 +10,7 @@ module type Config = sig end exception Library_not_found +exception Library_initialized of string let strnlen = foreign "strnlen" (ocaml_bytes @-> int @-> returning int) @@ -78,7 +79,12 @@ let int_of_load_type = function | `Repair_no_pnr -> 11069 | `Sublevel_pnr -> 10699 +let initialized = Atomic.make None + let init ?license_key ~filename () = + (match Atomic.get initialized with + | Some f when f <> filename -> raise (Library_initialized f) + | _ -> Atomic.set initialized (Some filename)); try let module C = C (struct let filename = filename diff --git a/src/stereotool/stereotool.mli b/src/stereotool/stereotool.mli index a47e80947f..8faeb30e1d 100644 --- a/src/stereotool/stereotool.mli +++ b/src/stereotool/stereotool.mli @@ -15,6 +15,7 @@ type load_type = | `Sublevel_pnr ] exception Library_not_found +exception Library_initialized of string val init : ?license_key:string -> filename:string -> unit -> t val software_version : t -> int From e7dce4d7a7ea426dbc134a29fe30d592411c269e Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 21 Oct 2024 13:34:32 -0500 Subject: [PATCH 070/151] Force string type. --- src/libs/extra/fades.liq | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/libs/extra/fades.liq b/src/libs/extra/fades.liq index 0a465375df..02d6d2070d 100644 --- a/src/libs/extra/fades.liq +++ b/src/libs/extra/fades.liq @@ -17,9 +17,9 @@ def cross.plot(~png=null(), ~dir=null(), s) = new_txt = path.concat(dir, "new.txt") def gnuplot_cmd(filename) = - 'set term png; set output "#{filename}"; plot "#{new_txt}" using 1:2 with \ - lines title "new track", "#{old_txt}" using 1:2 with lines title "old \ - track"' + 'set term png; set output "#{(filename : string)}"; plot "#{new_txt}" using \ + 1:2 with lines title "new track", "#{old_txt}" using 1:2 with lines title \ + "old track"' end def store_rms(~id, s) = From b1ad6404ef948eef183ef816b11647200336ba86 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 21 Oct 2024 13:46:59 -0500 Subject: [PATCH 071/151] Add missing deps. --- .github/scripts/build-posix.sh | 2 +- dune-project | 2 +- tls-liquidsoap.opam | 2 ++ 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/scripts/build-posix.sh b/.github/scripts/build-posix.sh index 717eebb70c..21422ac1a9 100755 --- a/.github/scripts/build-posix.sh +++ b/.github/scripts/build-posix.sh @@ -50,7 +50,7 @@ cd .. opam update opam remove -y jemalloc -opam install -y tls.1.0.2 saturn_lockfree.0.4.1 ppx_hash +opam install -y tls.1.0.2 ca-certs mirage-crypto-rng cstruct saturn_lockfree.0.4.1 ppx_hash memtrace cd /tmp/liquidsoap-full diff --git a/dune-project b/dune-project index e824a12ea1..eae8305866 100644 --- a/dune-project +++ b/dune-project @@ -181,7 +181,7 @@ (name tls-liquidsoap) (version 1) (allow_empty) - (depends tls ca-certs) + (depends tls ca-certs mirage-crypto-rng cstruct) (synopsis "Virtual package install liquidosap dependencies for TLS optional features") ) diff --git a/tls-liquidsoap.opam b/tls-liquidsoap.opam index e87aa42b70..c285a8aeb5 100644 --- a/tls-liquidsoap.opam +++ b/tls-liquidsoap.opam @@ -12,6 +12,8 @@ depends: [ "dune" {>= "3.6"} "tls" "ca-certs" + "mirage-crypto-rng" + "cstruct" "odoc" {with-doc} ] build: [ From 8a85f11d9a9c71303efd502fb648f67ac84ccc6d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 23 Oct 2024 08:49:44 -0500 Subject: [PATCH 072/151] Backport autocue improvements from 2.2.x (#4184) --- src/core/builtins/builtins_resolvers.ml | 30 +++- src/core/builtins/builtins_source.ml | 120 ++++++++++++--- src/core/clock.ml | 21 ++- src/core/clock.mli | 2 + src/core/operators/cross.ml | 189 ++++++++++++++++++++++-- src/core/stream/frame.ml | 7 +- src/core/stream/generator.ml | 10 ++ src/core/stream/generator.mli | 3 + src/libs/autocue.liq | 30 +++- src/libs/fades.liq | 103 ++++++++++--- tests/streams/crossfade-plot.new.txt | 1 - 11 files changed, 445 insertions(+), 71 deletions(-) diff --git a/src/core/builtins/builtins_resolvers.ml b/src/core/builtins/builtins_resolvers.ml index 5499a047a5..03cb1ae20b 100644 --- a/src/core/builtins/builtins_resolvers.ml +++ b/src/core/builtins/builtins_resolvers.ml @@ -35,6 +35,18 @@ let _ = Lang.getter_t Lang.int_t, Some (Lang.int 1), Some "Resolver's priority." ); + ( "mime_types", + Lang.nullable_t (Lang.list_t Lang.string_t), + Some Lang.null, + Some + "Decode files that match the mime types in this list. Accept any \ + file if `null`." ); + ( "file_extensions", + Lang.nullable_t (Lang.list_t Lang.string_t), + Some Lang.null, + Some + "Decode files that have the file extensions in this list. Accept any \ + file if `null`." ); ("", Lang.string_t, None, Some "Format/resolver's name."); ( "", resolver_t, @@ -47,11 +59,25 @@ let _ = (fun p -> let format = Lang.to_string (Lang.assoc "" 1 p) in let f = Lang.assoc "" 2 p in + let mimes = + Lang.to_valued_option + (fun v -> List.map Lang.to_string (Lang.to_list v)) + (List.assoc "mime_types" p) + in + let extensions = + Lang.to_valued_option + (fun v -> List.map Lang.to_string (Lang.to_list v)) + (List.assoc "file_extensions" p) + in + let log = Log.make ["decoder"; "metadata"] in let priority = Lang.to_int_getter (List.assoc "priority" p) in - let resolver ~metadata ~extension:_ ~mime:_ name = + let resolver ~metadata ~extension ~mime fname = + if + not (Decoder.test_file ~log ~extension ~mime ~mimes ~extensions fname) + then raise Metadata.Invalid; let ret = Lang.apply f - [("metadata", Lang.metadata metadata); ("", Lang.string name)] + [("metadata", Lang.metadata metadata); ("", Lang.string fname)] in let ret = Lang.to_list ret in let ret = List.map Lang.to_product ret in diff --git a/src/core/builtins/builtins_source.ml b/src/core/builtins/builtins_source.ml index 4bd5ad1f18..675d50aa56 100644 --- a/src/core/builtins/builtins_source.ml +++ b/src/core/builtins/builtins_source.ml @@ -178,11 +178,24 @@ let _ = Some "Time ratio. A value of `50` means process data at `50x` real rate, \ when possible." ); + ( "timeout", + Lang.float_t, + Some (Lang.float 1.), + Some + "Stop processing the source if it has not started after the given \ + timeout." ); + ( "sleep_latency", + Lang.float_t, + Some (Lang.float 0.1), + Some + "How much time ahead, in seconds, should we should be before pausing \ + the processing." ); ] Lang.unit_t (fun p -> let module Time = (val Clock.time_implementation () : Liq_time.T) in let open Time in + let started = ref false in let stopped = ref false in let proto = let p = Pipe_output.file_proto (Lang.univ_t ()) in @@ -198,18 +211,44 @@ let _ = p in let proto = ("fallible", Lang.bool true) :: proto in - let p = (("id", Lang.string "source_dumper") :: p) @ proto in - let clock = Clock.create ~id:"source_dumper" ~sync:`Passive () in - let _ = Pipe_output.new_file_output ~clock p in + let p = (("id", Lang.string "source.drop") :: p) @ proto in + let clock = + Clock.create ~id:"source.dump" ~sync:`Passive + ~on_error:(fun exn bt -> + stopped := true; + Utils.log_exception ~log + ~bt:(Printexc.raw_backtrace_to_string bt) + (Printf.sprintf "Error while dropping source: %s" + (Printexc.to_string exn))) + () + in + let s = Pipe_output.new_file_output ~clock p in let ratio = Lang.to_float (List.assoc "ratio" p) in - let latency = Time.of_float (Lazy.force Frame.duration /. ratio) in - Clock.start clock; + let timeout = Time.of_float (Lang.to_float (List.assoc "timeout" p)) in + let sleep_latency = + Time.of_float (Lang.to_float (List.assoc "sleep_latency" p)) + in + Clock.start ~force:true clock; log#info "Start dumping source (ratio: %.02fx)" ratio; - while (not (Atomic.get should_stop)) && not !stopped do - let start_time = Time.time () in - Clock.tick clock; - sleep_until (start_time |+| latency) - done; + let start_time = Time.time () in + let timeout_time = Time.(start_time |+| timeout) in + let target_time () = + Time.( + start_time |+| sleep_latency |+| of_float (Clock.time clock /. ratio)) + in + (try + while (not (Atomic.get should_stop)) && not !stopped do + if not !started then started := s#is_ready; + if (not !started) && Time.(timeout_time |<=| start_time) then ( + log#important "Timeout while waiting for the source to start!"; + stopped := true) + else ( + Clock.tick clock; + let target_time = target_time () in + if Time.(time () |<| (target_time |+| sleep_latency)) then + sleep_until target_time) + done + with Clock.Has_stopped -> ()); log#info "Source dumped."; Clock.stop clock; Lang.unit) @@ -227,14 +266,36 @@ let _ = Some "Time ratio. A value of `50` means process data at `50x` real rate, \ when possible." ); + ( "timeout", + Lang.float_t, + Some (Lang.float 1.), + Some + "Stop processing the source if it has not started after the given \ + timeout." ); + ( "sleep_latency", + Lang.float_t, + Some (Lang.float 0.1), + Some + "How much time ahead, in seconds, should we should be before pausing \ + the processing." ); ] Lang.unit_t (fun p -> let module Time = (val Clock.time_implementation () : Liq_time.T) in let open Time in let s = List.assoc "" p |> Lang.to_source in + let started = ref false in let stopped = ref false in - let clock = Clock.create ~id:"source_dumper" ~sync:`Passive () in + let clock = + Clock.create ~id:"source.dump" ~sync:`Passive + ~on_error:(fun exn bt -> + stopped := true; + Utils.log_exception ~log + ~bt:(Printexc.raw_backtrace_to_string bt) + (Printf.sprintf "Error while dropping source: %s" + (Printexc.to_string exn))) + () + in let _ = new Output.dummy ~clock ~infallible:false @@ -243,14 +304,35 @@ let _ = ~register_telnet:false ~autostart:true (Lang.source s) in let ratio = Lang.to_float (List.assoc "ratio" p) in - let latency = Time.of_float (Lazy.force Frame.duration /. ratio) in - Clock.start clock; + let timeout = Time.of_float (Lang.to_float (List.assoc "timeout" p)) in + let sleep_latency = + Time.of_float (Lang.to_float (List.assoc "sleep_latency" p)) + in + Clock.start ~force:true clock; log#info "Start dropping source (ratio: %.02fx)" ratio; - while (not (Atomic.get should_stop)) && not !stopped do - let start_time = Time.time () in - Clock.tick clock; - sleep_until (start_time |+| latency) - done; - log#info "Source dropped."; + let start_time = Time.time () in + let timeout_time = Time.(start_time |+| timeout) in + let target_time () = + Time.(start_time |+| of_float (Clock.time clock /. ratio)) + in + (try + while (not (Atomic.get should_stop)) && not !stopped do + let start_time = Time.time () in + if not !started then started := s#is_ready; + if (not !started) && Time.(timeout_time |<=| start_time) then ( + log#important "Timeout while waiting for the source to start!"; + stopped := true) + else ( + Clock.tick clock; + let target_time = target_time () in + if Time.(time () |<| (target_time |+| sleep_latency)) then + sleep_until target_time) + done + with Clock.Has_stopped -> ()); + let processing_time = Time.(to_float (time () |-| start_time)) in + let effective_ratio = Clock.time clock /. processing_time in + log#info + "Source dropped. Total processing time: %.02fs, effective ratio: %.02fx" + processing_time effective_ratio; Clock.stop clock; Lang.unit) diff --git a/src/core/clock.ml b/src/core/clock.ml index 79bb50dd7e..36ff5d4393 100644 --- a/src/core/clock.ml +++ b/src/core/clock.ml @@ -94,7 +94,7 @@ let conf_clock_preferred = let conf_clock_sleep_latency = Dtools.Conf.int ~p:(conf_clock#plug "sleep_latency") - ~d:1 + ~d:5 "How much time ahead (in frame duration) we should be until we let the \ streaming loop sleep." ~comments: @@ -316,9 +316,13 @@ let ticks c = | `Stopped _ -> 0 | `Stopping { ticks } | `Started { ticks } -> Atomic.get ticks -let _target_time { time_implementation; t0; frame_duration; ticks } = +let _time { time_implementation; frame_duration; ticks } = let module Time = (val time_implementation : Liq_time.T) in - Time.(t0 |+| (frame_duration |*| of_float (float_of_int (Atomic.get ticks)))) + Time.(frame_duration |*| of_float (float_of_int (Atomic.get ticks))) + +let _target_time ({ time_implementation; t0 } as c) = + let module Time = (val time_implementation : Liq_time.T) in + Time.(t0 |+| _time c) let _set_time { time_implementation; t0; frame_duration; ticks } t = let module Time = (val time_implementation : Liq_time.T) in @@ -464,7 +468,7 @@ and _can_start ?(force = false) clock = `True sync | _ -> `False -and _start ~sync clock = +and _start ?force ~sync clock = Unifier.set clock.id (Lang_string.generate_id (Unifier.deref clock.id)); let id = _id clock in log#important "Starting clock %s with %d source(s) and sync: %s" id @@ -497,14 +501,14 @@ and _start ~sync clock = ticks = Atomic.make 0; } in - Queue.iter clock.sub_clocks (fun c -> start c); + Queue.iter clock.sub_clocks (fun c -> start ?force c); Atomic.set clock.state (`Started x); if sync <> `Passive then _clock_thread ~clock x and start ?force c = let clock = Unifier.deref c in match _can_start ?force clock with - | `True sync -> _start ~sync clock + | `True sync -> _start ?force ~sync clock | `False -> () let create ?(stack = []) ?on_error ?(id = "generic") ?(sub_ids = []) @@ -526,6 +530,11 @@ let create ?(stack = []) ?on_error ?(id = "generic") ?(sub_ids = []) Queue.push clocks c; c +let time c = + let ({ time_implementation } as c) = active_params c in + let module Time = (val time_implementation : Liq_time.T) in + Time.to_float (_time c) + let start_pending () = let c = Queue.flush_elements clocks in let c = List.map (fun c -> (c, Unifier.deref c)) c in diff --git a/src/core/clock.mli b/src/core/clock.mli index e3f29827b1..57e8185cbc 100644 --- a/src/core/clock.mli +++ b/src/core/clock.mli @@ -21,6 +21,7 @@ *****************************************************************************) exception Invalid_state +exception Has_stopped type t type active_source = < reset : unit ; output : unit > @@ -96,6 +97,7 @@ val started : t -> bool val stop : t -> unit val set_stack : t -> Liquidsoap_lang.Pos.t list -> unit val self_sync : t -> bool +val time : t -> float val unify : pos:Liquidsoap_lang.Pos.Option.t -> t -> t -> unit val create_sub_clock : id:string -> t -> t val attach : t -> source -> unit diff --git a/src/core/operators/cross.ml b/src/core/operators/cross.ml index 21344a0fa1..6c7107631b 100644 --- a/src/core/operators/cross.ml +++ b/src/core/operators/cross.ml @@ -23,6 +23,16 @@ open Mm open Source +let conf = + Dtools.Conf.void ~p:(Configure.conf#plug "crossfade") "Crossfade settings" + +let conf_assume_autocue = + Dtools.Conf.bool + ~p:(conf#plug "assume_autocue") + ~d:false + "Assume autocue when all 4 cue in/out and fade in/out metadata override \ + are present." + class consumer ~clock buffer = object (self) inherit Source.source ~clock ~name:"cross.buffer" () @@ -42,7 +52,8 @@ class consumer ~clock buffer = * [cross_length] is in ticks (like #remaining estimations) and must be at least one frame. *) class cross val_source ~end_duration_getter ~override_end_duration ~override_duration ~start_duration_getter ~override_start_duration - ~override_max_start_duration ~persist_override ~rms_width transition = + ~override_max_start_duration ~persist_override ~rms_width ~assume_autocue + transition = let s = Lang.to_source val_source in let original_end_duration_getter = end_duration_getter in let original_start_duration_getter = start_duration_getter in @@ -159,6 +170,34 @@ class cross val_source ~end_duration_getter ~override_end_duration val mutable rmsi_after = 0 val mutable after_metadata = None + method private autocue_enabled mode = + let metadata, set_metadata = + match mode with + | `Before -> (before_metadata, fun m -> before_metadata <- Some m) + | `After -> (after_metadata, fun m -> after_metadata <- Some m) + in + match metadata with + | Some h -> ( + let has_metadata = + List.for_all + (fun v -> Frame.Metadata.mem v h) + ["liq_cue_in"; "liq_cue_out"; "liq_fade_in"; "liq_fade_out"] + in + let has_marker = Frame.Metadata.mem "liq_autocue" h in + match (has_marker, has_metadata, assume_autocue) with + | true, true, _ -> true + | true, false, _ -> + self#log#critical + "`\"liq_autocue\"` metadata is present but some of the cue \ + in/out and fade in/out metadata are missing!"; + false + | false, true, true -> + self#log#info "Assuming autocue"; + set_metadata (Frame.Metadata.add "liq_autocue" "assumed" h); + true + | _ -> false) + | None -> false + method private reset_analysis = gen_before <- Generator.create self#content_type; gen_after <- Generator.create self#content_type; @@ -351,8 +390,78 @@ class cross val_source ~end_duration_getter ~override_end_duration in f ~is_first:true () + method private append_before_metadata lbl value = + before_metadata <- + Some + (Frame.Metadata.add lbl value + (Option.value ~default:Frame.Metadata.empty before_metadata)) + + method private append_after_metadata lbl value = + after_metadata <- + Some + (Frame.Metadata.add lbl value + (Option.value ~default:Frame.Metadata.empty after_metadata)) + + method private autocue_adjustements ~before_autocue ~after_autocue + ~buffered_before ~buffered_after ~buffered () = + let before_metadata = + Option.value ~default:Frame.Metadata.empty before_metadata + in + let extra_cross_duration = buffered_before - buffered_after in + if after_autocue then ( + if before_autocue && 0 < extra_cross_duration then ( + let new_cross_duration = buffered_before - extra_cross_duration in + Generator.keep gen_before new_cross_duration; + let new_cross_duration = Frame.seconds_of_main new_cross_duration in + let extra_cross_duration = + Frame.seconds_of_main extra_cross_duration + in + self#log#info + "Shortening ending track by %.2f to match the starting track's \ + buffer." + extra_cross_duration; + let fade_out = + float_of_string (Frame.Metadata.find "liq_fade_out" before_metadata) + in + let fade_out = min new_cross_duration fade_out in + let fade_out_delay = max (new_cross_duration -. fade_out) 0. in + self#append_before_metadata "liq_fade_out" (string_of_float fade_out); + self#append_before_metadata "liq_fade_out_delay" + (string_of_float fade_out_delay)); + (try + let cross_duration = Frame.seconds_of_main buffered in + let cue_out = + float_of_string (Frame.Metadata.find "liq_cue_out" before_metadata) + in + let start_next = + float_of_string + (Frame.Metadata.find "liq_cross_start_next" before_metadata) + in + if cue_out -. start_next < cross_duration then ( + self#log#info "Adding fade-in delay to match start next"; + self#append_after_metadata "liq_fade_in_delay" + (string_of_float (cross_duration -. cue_out +. start_next))) + with _ -> ()); + let fade_out_delay = + try + float_of_string + (Frame.Metadata.find "liq_fade_out_delay" before_metadata) + with _ -> 0. + in + if 0. < fade_out_delay then ( + self#log#info + "Adding %.2f fade-in delay to match the ending track's buffer" + fade_out_delay; + self#append_after_metadata "liq_fade_in_delay" + (string_of_float fade_out_delay))) + (* Sum up analysis and build the transition *) method private create_after = + let before_autocue = self#autocue_enabled `Before in + let after_autocue = self#autocue_enabled `After in + let buffered_before = Generator.length gen_before in + let buffered_after = Generator.length gen_after in + let buffered = min buffered_before buffered_after in let db_after = Audio.dB_of_lin (sqrt (rms_after /. float rmsi_after /. float self#audio_channels)) @@ -361,20 +470,51 @@ class cross val_source ~end_duration_getter ~override_end_duration Audio.dB_of_lin (sqrt (rms_before /. float rmsi_before /. float self#audio_channels)) in - let buffered_before = Generator.length gen_before in - let buffered_after = Generator.length gen_after in + self#autocue_adjustements ~before_autocue ~after_autocue ~buffered_before + ~buffered_after ~buffered (); let compound = let metadata = function None -> Frame.Metadata.empty | Some m -> m in let before_metadata = metadata before_metadata in let after_metadata = metadata after_metadata in - let before = new consumer ~clock:source#clock gen_before in - Typing.(before#frame_type <: self#frame_type); - let before = new Insert_metadata.replay before_metadata before in + let before_head = + if (not after_autocue) && buffered < buffered_before then ( + let head = + Generator.slice gen_before (buffered_before - buffered) + in + let head_gen = + Generator.create ~content:head (Generator.content_type gen_before) + in + let s = new consumer ~clock:source#clock head_gen in + s#set_id (self#id ^ "_before_head"); + Typing.(s#frame_type <: self#frame_type); + Some s) + else None + in + let before = + new Insert_metadata.replay + before_metadata + (new consumer ~clock:source#clock gen_before) + in Typing.(before#frame_type <: self#frame_type); - before#set_id (self#id ^ "_before"); - let after = new consumer ~clock:source#clock gen_after in - Typing.(after#frame_type <: self#frame_type); - let after = new Insert_metadata.replay after_metadata after in + let after_tail = + if (not after_autocue) && buffered < buffered_after then ( + let head = Generator.slice gen_after buffered in + let head_gen = + Generator.create ~content:head (Generator.content_type gen_after) + in + let tail_gen = gen_after in + gen_after <- head_gen; + let s = new consumer ~clock:source#clock tail_gen in + Typing.(s#frame_type <: self#frame_type); + s#set_id (self#id ^ "_after_tail"); + Some s) + else None + in + let after = + new Insert_metadata.replay + after_metadata + (new consumer ~clock:source#clock gen_after) + in Typing.(after#frame_type <: self#frame_type); before#set_id (self#id ^ "_before"); after#set_id (self#id ^ "_after"); @@ -404,6 +544,19 @@ class cross val_source ~end_duration_getter ~override_end_duration Lang.to_source (Lang.apply transition params) in Typing.(compound#frame_type <: self#frame_type); + let compound = + match (before_head, after_tail) with + | None, None -> (compound :> Source.source) + | Some s, None -> + (new Sequence.sequence ~merge:true [s; compound] + :> Source.source) + | None, Some s -> + (new Sequence.sequence ~single_track:false [compound; s] + :> Source.source) + | Some _, Some _ -> assert false + in + Clock.unify ~pos:self#pos compound#clock s#clock; + Typing.(compound#frame_type <: self#frame_type); compound in self#prepare_source compound; @@ -466,6 +619,13 @@ let _ = Some "Duration (in seconds) of buffered data from the end and start of \ each track that is used to compute the transition between tracks." ); + ( "assume_autocue", + Lang.nullable_t Lang.bool_t, + Some Lang.null, + Some + "Assume that a track has autocue enabled when all four cue in/out \ + and fade in/out override metadata are present. Defaults to \ + `settings.crossfade.assume_autocue` when `null`." ); ( "override_start_duration", Lang.string_t, Some (Lang.string "liq_cross_start_duration"), @@ -529,6 +689,12 @@ let _ = depending on the relative power of the signal before and after the end \ of track." (fun p -> + let assume_autocue = + Lang.to_valued_option Lang.to_bool (List.assoc "assume_autocue" p) + in + let assume_autocue = + Option.value ~default:conf_assume_autocue#get assume_autocue + in let start_duration_getter = Lang.to_valued_option Lang.to_float_getter (List.assoc "start_duration" p) @@ -563,4 +729,5 @@ let _ = new cross source transition ~start_duration_getter ~end_duration_getter ~rms_width ~override_start_duration ~override_max_start_duration - ~override_end_duration ~override_duration ~persist_override) + ~override_end_duration ~override_duration ~persist_override + ~assume_autocue) diff --git a/src/core/stream/frame.ml b/src/core/stream/frame.ml index 7c98a4df5b..c4b40fc5ed 100644 --- a/src/core/stream/frame.ml +++ b/src/core/stream/frame.ml @@ -47,9 +47,12 @@ module S = Set.Make (struct let compare = Stdlib.compare end) +let filter_implicit_fields (lbl, _) = + if List.mem lbl [Fields.metadata; Fields.track_marks] then None else Some lbl + let assert_compatible c c' = - let f = List.map fst (Fields.bindings c) in - let f' = List.map fst (Fields.bindings c') in + let f = List.filter_map filter_implicit_fields (Fields.bindings c) in + let f' = List.filter_map filter_implicit_fields (Fields.bindings c') in if not S.(equal (of_list f) (of_list f')) then failwith (Printf.sprintf diff --git a/src/core/stream/generator.ml b/src/core/stream/generator.ml index 0fef15ae00..b903f28e49 100644 --- a/src/core/stream/generator.ml +++ b/src/core/stream/generator.ml @@ -112,6 +112,16 @@ let _truncate ?(allow_desync = false) gen len = let truncate gen = Mutex_utils.mutexify gen.lock (_truncate gen) +let _keep gen len = + Atomic.set gen.content + (Frame_base.Fields.map + (fun content -> + assert (len <= Content.length content); + Content.sub content 0 len) + (Atomic.get gen.content)) + +let keep gen = Mutex_utils.mutexify gen.lock (_keep gen) + let _slice gen len = let content = Atomic.get gen.content in let len = diff --git a/src/core/stream/generator.mli b/src/core/stream/generator.mli index 4b305d2675..5f12e47a0e 100644 --- a/src/core/stream/generator.mli +++ b/src/core/stream/generator.mli @@ -70,6 +70,9 @@ val remaining : t -> int (* Drop given length of content at the beginning of the generator. *) val truncate : t -> int -> unit +(* Keep only the given length of data from the beginning of the generator. *) +val keep : t -> int -> unit + (* Return at most the given len of data from the start of the generator and truncate the generator of that data. *) val slice : t -> int -> Frame.t diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index d6763ef501..78eac15f4e 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -155,7 +155,7 @@ let settings.autocue.internal.ratio = settings.make( description= "Maximum real time ratio to control speed of LUFS data analysis", - 50. + 223. ) let settings.autocue.internal.timeout = @@ -217,7 +217,10 @@ def autocue.internal.ebur128(~duration, ~ratio=50., ~timeout=10., filename) = let {audio = a} = source.tracks(s) a = ffmpeg.filter.audio.input(graph, a) let ([a], _) = ffmpeg.filter.ebur128(metadata=true, graph, a) - a = ffmpeg.filter.audio.output(graph, a) + + # ebur filter seems to generate invalid PTS. + a = ffmpeg.filter.asetpts(expr="N/SR/TB", graph, a) + a = ffmpeg.filter.audio.output(id="filter_output", graph, a) source({audio=a, metadata=track.metadata(a)}) end @@ -805,7 +808,7 @@ let file.autocue = () # Return the file's autocue values as metadata suitable for metadata override. # @category Source / Audio processing -def file.autocue.metadata(~metadata, uri) = +def file.autocue.metadata(~request_metadata, uri) = preferred_implementation = settings.autocue.preferred() implementations = settings.autocue.implementations() @@ -856,7 +859,7 @@ def file.autocue.metadata(~metadata, uri) = try autocue = implementation( - request_metadata=metadata, + request_metadata=request_metadata, file_metadata=request.metadata(r), request.filename(r) ) @@ -987,7 +990,7 @@ def enable_autocue_metadata() = ) [] else - autocue_metadata = file.autocue.metadata(metadata=metadata, fname) + autocue_metadata = file.autocue.metadata(request_metadata=metadata, fname) all_amplify = [...settings.autocue.amplify_aliases(), "liq_amplify"] @@ -1062,15 +1065,28 @@ def enable_autocue_metadata() = autocue_metadata end end + +%ifdef settings.decoder.mime_types.ffmpeg + mime_types = settings.decoder.mime_types.ffmpeg() + file_extensions = settings.decoder.file_extensions.ffmpeg() +%else + mime_types = null() + file_extensions = null() +%endif + decoder.metadata.add( - priority=settings.autocue.metadata.priority, "autocue", autocue_metadata + mime_types=mime_types, + file_extensions=file_extensions, + priority=settings.autocue.metadata.priority, + "autocue", + autocue_metadata ) end # Define autocue protocol # @flag hidden def protocol.autocue(~rlog=_, ~maxtime=_, arg) = - cue_metadata = file.autocue.metadata(metadata=[], arg) + cue_metadata = file.autocue.metadata(request_metadata=[], arg) if cue_metadata != [] diff --git a/src/libs/fades.liq b/src/libs/fades.liq index f305ce0170..520bc6c000 100644 --- a/src/libs/fades.liq +++ b/src/libs/fades.liq @@ -1,5 +1,62 @@ fade = () +let settings.fade = + settings.make.void( + "Settings for the fade in/out operators" + ) + +let settings.fade.in = + settings.make.void( + "Settings for fade.in operators" + ) + +let settings.fade.in.duration = + settings.make( + description= + "Default fade.in duration", + 3. + ) + +let settings.fade.in.type = + settings.make( + description= + "Default fade.in type", + "lin" + ) + +let settings.fade.in.curve = + settings.make( + description= + "Default fade.in curve", + 10. + ) + +let settings.fade.out = + settings.make.void( + "Settings for fade.out operators" + ) + +let settings.fade.out.duration = + settings.make( + description= + "Default fade.out duration", + 3. + ) + +let settings.fade.out.type = + settings.make( + description= + "Default fade.out type", + "exp" + ) + +let settings.fade.out.curve = + settings.make( + description= + "Default fade.out curve", + 3. + ) + # Make a fade function based on a source's clock. # @category Source / Fade # @param ~curve Fade curve for `"log"` and `"exp"` shapes. If `null`, depends on the type of fade. \ @@ -31,7 +88,7 @@ def mkfade( (1. + sin((x - 0.5) * pi)) / 2. end - exp_curve = curve ?? 2. + exp_curve = curve ?? 3. m = exp(exp_curve - 1.) - exp(-1.) def exp_shape(x) = @@ -104,9 +161,9 @@ end # Fade the end of tracks. # @category Source / Fade # @param ~id Force the value of the source ID. -# @param ~duration Duration of the fading. This value can be set on a per-file basis using the metadata field passed as override. -# @param ~delay Initial delay before starting fade. -# @param ~curve Fade curve. Default if `null`. +# @param ~duration Duration of the fading. This value can be set on a per-file basis using the metadata field passed as override. Defaults to `settings.fade.out.curve` if `null`. +# @param ~delay Initial delay before starting fade. Defaults to `settings.fade.out.delay` if `null`. +# @param ~curve Fade curve. Defaults to `settings.fade.out.curve` if `null`. # @param ~override_duration Metadata field which, if present and containing a float, overrides the 'duration' parameter for the current track. # @param ~override_type Metadata field which, if present and correct, overrides the 'type' parameter for the current track. # @param ~override_curve Metadata field which, if presents and correct, overrides the `curve` parameter for the current track. Use `"default"` \ @@ -115,10 +172,10 @@ end # @param ~persist_overrides Keep duration and type overrides on track change. # @param ~track_sensitive Be track sensitive (if `false` we only fade ou once at the beginning of the track). # @param ~initial_metadata Initial metadata. -# @param ~type Fader shape (lin|sin|log|exp): linear, sinusoidal, logarithmic or exponential. +# @param ~type Fader shape. One of: "lin"", "sin", "log" or "exp". Defaults to `settings.fade.out.type` if `null`. def fade.out( ~id="fade.out", - ~duration=3., + ~duration=null(), ~delay=0., ~curve=null(), ~override_duration="liq_fade_out", @@ -128,7 +185,7 @@ def fade.out( ~persist_overrides=false, ~track_sensitive=false, ~initial_metadata=[], - ~type="lin", + ~type=null(), s ) = def log(x) = @@ -136,12 +193,12 @@ def fade.out( end fn = ref(fun () -> 1.) - original_type = type - type = ref(type) - original_curve = curve - curve = ref(curve) - original_duration = duration - duration = ref(duration) + original_type = type ?? settings.fade.out.type() + type = ref(original_type) + original_curve = (curve ?? settings.fade.out.curve() : float?) + curve = ref(original_curve) + original_duration = duration ?? settings.fade.out.duration() + duration = ref(original_duration) original_delay = delay delay = ref(original_delay) start_time = ref(-1.) @@ -475,9 +532,9 @@ end # Fade the beginning of tracks. # @category Source / Fade # @param ~id Force the value of the source ID. -# @param ~duration Duration of the fading. This value can be set on a per-file basis using the metadata field passed as override. +# @param ~duration Duration of the fading. This value can be set on a per-file basis using the metadata field passed as override. Defaults to `settings.fade.in.duration` if `null`. # @param ~delay Initial delay before starting fade. -# @param ~curve Fade curve. Default if `null`. +# @param ~curve Fade curve. Defaults to `settings.fade.in.curve` if `null`. # @param ~override_duration Metadata field which, if present and containing a float, overrides the 'duration' parameter for the current track. # @param ~override_type Metadata field which, if present and correct, overrides the 'type' parameter for the current track. # @param ~override_curve Metadata field which, if presents and correct, overrides the `curve` parameter for the current track. Use `"default"` \ @@ -486,10 +543,10 @@ end # @param ~persist_overrides Keep duration and type overrides on track change. # @param ~track_sensitive Be track sensitive (if `false` we only fade in once at the beginning of the track). # @param ~initial_metadata Initial metadata. -# @param ~type Fader shape (lin|sin|log|exp): linear, sinusoidal, logarithmic or exponential. +# @param ~type Fader shape. One of: "lin"", "sin", "log" or "exp". Defaults to `settings.fade.in.type` if `null`. def fade.in( ~id="fade.in", - ~duration=3., + ~duration=null(), ~delay=0., ~curve=null(), ~override_duration="liq_fade_in", @@ -499,7 +556,7 @@ def fade.in( ~persist_overrides=false, ~track_sensitive=false, ~initial_metadata=[], - ~type="lin", + ~type=null(), s ) = def log(x) = @@ -507,13 +564,13 @@ def fade.in( end fn = ref(fun () -> 0.) - original_duration = duration - duration = ref(duration) + original_duration = duration ?? settings.fade.in.duration() + duration = ref(original_duration) original_delay = delay delay = ref(original_delay) - original_type = type - type = ref(type) - original_curve = curve + original_type = type ?? settings.fade.in.type() + type = ref(original_type) + original_curve = curve ?? settings.fade.in.curve() curve = ref(curve) last_metadata = ref(initial_metadata) diff --git a/tests/streams/crossfade-plot.new.txt b/tests/streams/crossfade-plot.new.txt index 1f4eb392ab..117252ba73 100644 --- a/tests/streams/crossfade-plot.new.txt +++ b/tests/streams/crossfade-plot.new.txt @@ -248,4 +248,3 @@ 4.94 0.70746027805 4.96 0.708973694512 4.98 0.707908080993 -5.0 0.70573157718 From 7211e869ba82482c225ec143a6d8358b7ee8c92e Mon Sep 17 00:00:00 2001 From: "RadioMonster.FM" <40538914+RM-FM@users.noreply.github.com> Date: Thu, 24 Oct 2024 17:37:49 +0200 Subject: [PATCH 073/151] Change default values for fade out type and autocue loudness target (#4188) --- src/libs/autocue.liq | 2 +- src/libs/fades.liq | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index 78eac15f4e..c549b28e19 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -82,7 +82,7 @@ let settings.autocue.internal.lufs_target = settings.make( description= "Loudness target", - -16.0 + -14.0 ) let settings.autocue.internal.cue_in_threshold = diff --git a/src/libs/fades.liq b/src/libs/fades.liq index 520bc6c000..d5f142537d 100644 --- a/src/libs/fades.liq +++ b/src/libs/fades.liq @@ -47,14 +47,14 @@ let settings.fade.out.type = settings.make( description= "Default fade.out type", - "exp" + "lin" ) let settings.fade.out.curve = settings.make( description= "Default fade.out curve", - 3. + 10. ) # Make a fade function based on a source's clock. From 808885c0a73fbd7da5e3c68783f24a7f2e9b0d92 Mon Sep 17 00:00:00 2001 From: Samuel Mimram Date: Fri, 25 Oct 2024 18:35:41 +0200 Subject: [PATCH 074/151] Show error message once for native fonts. (#4191) --- src/core/decoder/text/video_text_native.ml | 4 +++- src/lang/extralib.ml | 12 ++++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/src/core/decoder/text/video_text_native.ml b/src/core/decoder/text/video_text_native.ml index 07acd11847..14829d4429 100644 --- a/src/core/decoder/text/video_text_native.ml +++ b/src/core/decoder/text/video_text_native.ml @@ -21,12 +21,14 @@ *****************************************************************************) open Mm +open Extralib let log = Log.make ["video"; "text"; "native"] let render_text ~font ~size text = if font <> Configure.conf_default_font#get then - log#important "video.text.native does not support custom fonts yet!"; + Fun.once (fun () -> + log#important "video.text.native does not support custom fonts yet!"); let () = ignore font in let font = Image.Bitmap.Font.native in let bmp = Image.Bitmap.Font.render text in diff --git a/src/lang/extralib.ml b/src/lang/extralib.ml index 1b493aff04..4b387d6a1d 100644 --- a/src/lang/extralib.ml +++ b/src/lang/extralib.ml @@ -88,3 +88,15 @@ module Int = struct assert false with Exit -> !ans end + +module Fun = struct + include Fun + + (** Execute a function at most once. *) + let once = + let already = ref false in + fun f -> + if not !already then ( + already := true; + f ()) +end From 63aea1bdb2b2d10fe363cb84b2001632ddc0a57c Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 26 Oct 2024 11:10:44 -0500 Subject: [PATCH 075/151] Fix tracks runtime type check. (#4193) --- src/core/hooks_implementations.ml | 2 +- src/core/source.ml | 6 ++++-- src/core/types/format_type.ml | 2 +- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/core/hooks_implementations.ml b/src/core/hooks_implementations.ml index 3b0e068a57..28c252dba6 100644 --- a/src/core/hooks_implementations.ml +++ b/src/core/hooks_implementations.ml @@ -20,7 +20,7 @@ let eval_check ~env:_ ~tm v = s#content_type_computation_allowed)) else if Source_tracks.is_value v then ( let s = Source_tracks.source v in - Typing.(s#frame_type <: tm.Term.t)) + Typing.(s#frame_type <: Type.fresh tm.Term.t)) else if Track.is_value v then ( let field, source = Lang_source.to_track v in if not source#has_content_type then ( diff --git a/src/core/source.ml b/src/core/source.ml index d6c681ff01..abe9b4a222 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -215,8 +215,10 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = try self#content_type_computation_allowed; if log == source_log then self#create_log; - source_log#info "Source %s gets up with content type: %s." id - (Frame.string_of_content_type self#content_type); + source_log#info + "Source %s gets up with content type: %s and frame type: %s." id + (Frame.string_of_content_type self#content_type) + (Type.to_string self#frame_type); self#log#debug "Clock is %s." (Clock.id self#clock); self#log#important "Content type is %s." (Frame.string_of_content_type self#content_type); diff --git a/src/core/types/format_type.ml b/src/core/types/format_type.ml index df04082965..6d9b6d7ff0 100644 --- a/src/core/types/format_type.ml +++ b/src/core/types/format_type.ml @@ -53,7 +53,7 @@ module FormatSpecs = struct let subtype _ f f' = Content_base.merge f f' let sup _ f f' = - Content_base.merge f f'; + Content_base.(merge (duplicate f) (duplicate f')); f let to_string _ = assert false From 4f5e308fac8814ec81955dd10da082becd47b2e6 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 27 Oct 2024 10:41:50 -0500 Subject: [PATCH 076/151] Cleanup inotify watch when garbage collected. --- src/core/file_watcher.inotify.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/file_watcher.inotify.ml b/src/core/file_watcher.inotify.ml index 5e81b9b831..3ac1c84a26 100644 --- a/src/core/file_watcher.inotify.ml +++ b/src/core/file_watcher.inotify.ml @@ -48,7 +48,8 @@ let rec watchdog () = (fun (wd, _, _, _) -> match List.assoc wd !handlers with | f -> f () - | exception Not_found -> ()) + | exception Not_found -> ( + try Inotify.rm_watch fd wd with _ -> ())) events; [watchdog ()]) in @@ -76,6 +77,7 @@ let watch : watch = let e = List.flatten (List.map event_conv e) in let wd = Inotify.add_watch fd file e in handlers := (wd, f) :: !handlers; + let finalise fn = fn () in let unwatch = Mutex_utils.mutexify m (fun () -> (try Inotify.rm_watch fd wd @@ -86,5 +88,6 @@ let watch : watch = (Printexc.to_string exn))); handlers := List.remove_assoc wd !handlers) in + Gc.finalise finalise unwatch; unwatch) () From ab6315d7ac5ecc61d9c93d1788b015cbca8e8b93 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 27 Oct 2024 22:04:32 -0500 Subject: [PATCH 077/151] Set ratio to 70x --- src/libs/autocue.liq | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index c549b28e19..ad1856ddab 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -155,7 +155,7 @@ let settings.autocue.internal.ratio = settings.make( description= "Maximum real time ratio to control speed of LUFS data analysis", - 223. + 70. ) let settings.autocue.internal.timeout = From ce7f2916195c6e06774828981a5a917d1e8b85c0 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 27 Oct 2024 22:15:02 -0500 Subject: [PATCH 078/151] No TODO here. --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 26ac685fca..11145fca0c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -18,7 +18,7 @@ New: `self-sync`. See @TODO@ for more details. (#3781) - Allow frames duration shorter than one video frames, typically values under `0.04s`. Smaller frames means less latency and memory consumption at the expense of - a higher CPU usage. See @TODO@ for more details (#3607) + a higher CPU usage (#3607) - Change default frame duration to `0.02s` (#4033) - Optimized runtime (#3927, #3928, #3919) - Added `finally` to execute code regardless of whether or not an exception is raised From a7031017c664ce267240ae9bef0e094da229e1af Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 29 Oct 2024 09:03:49 -0500 Subject: [PATCH 079/151] Add global request timeout setting. (#4196) --- CHANGES.md | 1 + src/core/builtins/builtins_request.ml | 28 +++++++++++++++++---------- src/core/request.ml | 9 +++++++-- src/core/request.mli | 7 ++++--- src/core/sources/request_dynamic.ml | 16 ++++++++------- src/libs/playlist.liq | 10 +++++----- src/libs/request.liq | 6 +++--- src/runtime/main.ml | 2 +- 8 files changed, 48 insertions(+), 31 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 11145fca0c..633777dd1e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -62,6 +62,7 @@ New: - Added atomic file write operations. - Added new `macos_say` speech synthesis protocol. Make it the default implementation for the `say:` protocol on `macos`. +- Added `settings.request.timeout` to set the request timeout globally. Changed: diff --git a/src/core/builtins/builtins_request.ml b/src/core/builtins/builtins_request.ml index 9797595208..3fb1b53ca3 100644 --- a/src/core/builtins/builtins_request.ml +++ b/src/core/builtins/builtins_request.ml @@ -100,9 +100,11 @@ let _ = Lang.add_builtin ~base:request "resolve" ~category:`Liquidsoap [ ( "timeout", - Lang.float_t, - Some (Lang.float 30.), - Some "Limit in seconds to the duration of the resolving." ); + Lang.nullable_t Lang.float_t, + Some Lang.null, + Some + "Limit in seconds to the duration of the request resolution. \ + Defaults to `settings.request.timeout` when `null`." ); ("", Request.Value.t, None, None); ] Lang.bool_t @@ -113,9 +115,11 @@ let _ = should not be decoded afterward: this is mostly useful to download \ files such as playlists, etc." (fun p -> - let timeout = Lang.to_float (List.assoc "timeout" p) in + let timeout = + Lang.to_valued_option Lang.to_float (List.assoc "timeout" p) + in let r = Request.Value.of_value (List.assoc "" p) in - Lang.bool (try Request.resolve r timeout = `Resolved with _ -> false)) + Lang.bool (try Request.resolve ?timeout r = `Resolved with _ -> false)) let _ = Lang.add_builtin ~base:request "metadata" ~category:`Liquidsoap @@ -211,9 +215,11 @@ let _ = "Optional metadata used to decode the file, e.g. \ `ffmpeg_options`." ); ( "timeout", - Lang.float_t, - Some (Lang.float 30.), - Some "Limit in seconds to the duration of the resolving." ); + Lang.nullable_t Lang.float_t, + Some Lang.null, + Some + "Limit in seconds to the duration of request resolution. \ + Defaults to `settings.request.timeout` when `null`." ); ("", Lang.string_t, None, None); ]) (Lang.nullable_t Lang.float_t) @@ -237,12 +243,14 @@ let _ = | Some r -> Some [r] in let metadata = Lang.to_metadata (List.assoc "metadata" p) in - let timeout = Lang.to_float (List.assoc "timeout" p) in + let timeout = + Lang.to_valued_option Lang.to_float (List.assoc "timeout" p) + in let r = Request.create ~resolve_metadata ~metadata ~cue_in_metadata:None ~cue_out_metadata:None f in - if Request.resolve r timeout = `Resolved then ( + if Request.resolve ?timeout r = `Resolved then ( match Request.duration ?resolvers ~metadata:(Request.metadata r) (Option.get (Request.get_filename r)) diff --git a/src/core/request.ml b/src/core/request.ml index b2d9b0dc72..6fc204af8a 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -44,6 +44,10 @@ let conf_add_on_air = "by an output."; ] +let conf_timeout = + Dtools.Conf.float ~p:(conf#plug "timeout") ~d:29. + "Default request resolution timeout." + let log = Log.make ["request"] let pretty_date date = @@ -638,6 +642,7 @@ let () = Atomic.set should_fail true) let resolve_req t timeout = + let timeout = Option.value ~default:conf_timeout#get timeout in log#debug "Resolving request %s." (string_of_indicators t); let since = Unix.gettimeofday () in Atomic.set t.status (`Resolving { since; pending = [] }); @@ -717,7 +722,7 @@ let resolve_req t timeout = | _ -> assert false); result -let rec resolve t timeout = +let rec resolve ?timeout t = match Atomic.get t.status with | `Idle -> resolve_req t timeout | `Resolving ({ pending } as r) as status -> @@ -730,7 +735,7 @@ let rec resolve t timeout = (`Resolving { r with pending = (c, m) :: pending }) then Condition.wait c m) (); - resolve t timeout + resolve ?timeout t | `Ready -> `Resolved | `Destroyed | `Failed -> `Failed diff --git a/src/core/request.mli b/src/core/request.mli index 80a8bd68b5..22295cf8ee 100644 --- a/src/core/request.mli +++ b/src/core/request.mli @@ -116,9 +116,10 @@ val conf_metadata_decoder_priorities : Dtools.Conf.ut (** Read the request's metadata. *) val read_metadata : t -> unit -(** [resolve request timeout] tries to resolve the request within - [timeout] seconds. *) -val resolve : t -> float -> resolve_flag +(** [resolve ?timeout request] tries to resolve the request within + [timeout] seconds. Defaults to [settings.request.timeout] when + [timeout] is not passed. *) +val resolve : ?timeout:float -> t -> resolve_flag (** [resolved r] if there's an available local filename. It can be true even if the resolving hasn't been run, if the initial URI was already a local diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml index 676f94e0f5..8995487d85 100644 --- a/src/core/sources/request_dynamic.ml +++ b/src/core/sources/request_dynamic.ml @@ -50,7 +50,7 @@ let log_failed_request (log : Log.t) request ans = let extract_queued_params p = let l = Lang.to_valued_option Lang.to_int (List.assoc "prefetch" p) in let l = Option.value ~default:conf_prefetch#get l in - let t = Lang.to_float (List.assoc "timeout" p) in + let t = Lang.to_valued_option Lang.to_float (List.assoc "timeout" p) in (l, t) let should_fail = Atomic.make false @@ -199,14 +199,14 @@ class dynamic ~priority ~retry_delay ~available (f : Lang.value) prefetch method set_queue = self#clear_retrieved; List.iter (fun request -> - match Request.resolve request timeout with + match Request.resolve ?timeout request with | `Resolved when Request.has_decoder ~ctype:self#content_type request -> Queue.push retrieved { request; expired = false } | ans -> log_failed_request self#log request ans) method add i = - match Request.resolve i.request timeout with + match Request.resolve ?timeout i.request with | `Resolved when Request.has_decoder ~ctype:self#content_type i.request -> Queue.push retrieved i; @@ -286,7 +286,7 @@ class dynamic ~priority ~retry_delay ~available (f : Lang.value) prefetch match r with | `Retry -> `Retry | `Request req -> ( - match Request.resolve req timeout with + match Request.resolve ?timeout req with | `Resolved when Request.has_decoder ~ctype:self#content_type req -> let rec remove_expired ret = @@ -355,9 +355,11 @@ let _ = Some Lang.null, Some "How many requests should be queued in advance." ); ( "timeout", - Lang.float_t, - Some (Lang.float 20.), - Some "Timeout (in sec.) to resolve the request." ); + Lang.nullable_t Lang.float_t, + Some Lang.null, + Some + "Timeout (in sec.) to resolve the request. Defaults to \ + `settings.request.timeout` when `null`." ); ] ~meth: [ diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq index a52141d152..8502d2b802 100644 --- a/src/libs/playlist.liq +++ b/src/libs/playlist.liq @@ -106,7 +106,7 @@ end def playlist.files( ~id=null(), ~mime_type=null(), - ~timeout=20., + ~timeout=null(), ~cue_in_metadata=null("liq_cue_in"), ~cue_out_metadata=null("liq_cue_out"), uri @@ -190,7 +190,7 @@ let stdlib_native = native # @param ~on_done Function executed when the playlist is finished. # @param ~max_fail When this number of requests fail to resolve, the whole playlists is considered as failed and `on_fail` is called. # @param ~on_fail Function executed when too many requests failed and returning the contents of a fixed playlist. -# @param ~timeout Timeout (in sec.) to resolve the request. +# @param ~timeout Timeout (in sec.) to resolve the request. Defaults to `settings.request.timeout` when `null`. # @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. # @param ~cue_out_metadata Metadata for cue out points. Disabled if `null`. # @param playlist Playlist. @@ -208,7 +208,7 @@ def playlist.list( ~on_done={()}, ~max_fail=10, ~on_fail=null(), - ~timeout=20., + ~timeout=null(), ~cue_in_metadata=null("liq_cue_in"), ~cue_out_metadata=null("liq_cue_out"), playlist @@ -463,7 +463,7 @@ end # @param ~reload_mode Unit of the reload parameter, either "never" (never reload \ # the playlist), "rounds", "seconds" or "watch" (reload the file whenever it is \ # changed). -# @param ~timeout Timeout (in sec.) to resolve the request. +# @param ~timeout Timeout (in sec.) to resolve the request. Defaults to `settings.request.timeout` when `null`. # @param ~thread_queue Queue used to resolve requests. # @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. # @param ~cue_out_metadata Metadata for cue out points. Disabled if `null`. @@ -487,7 +487,7 @@ def replaces playlist( ~prefix="", ~reload=0, ~reload_mode="seconds", - ~timeout=20., + ~timeout=null(), ~cue_in_metadata=null("liq_cue_in"), ~cue_out_metadata=null("liq_cue_out"), uri diff --git a/src/libs/request.liq b/src/libs/request.liq index 675c779481..77bcd18dae 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -39,7 +39,7 @@ def request.queue( ~native=false, ~queue=[], ~thread_queue="generic", - ~timeout=20. + ~timeout=null() ) = ignore(native) id = string.id.default(default="request.queue", id) @@ -233,7 +233,7 @@ end def request.once( ~id=null("request.once"), ~thread_queue="generic", - ~timeout=20., + ~timeout=null(), r ) = id = string.id.default(default="request.once", id) @@ -282,7 +282,7 @@ end def request.single( ~id=null("request.single"), ~prefetch=null(), - ~timeout=20., + ~timeout=null(), ~thread_queue="generic", ~fallible=null(), r diff --git a/src/runtime/main.ml b/src/runtime/main.ml index 4691f0c774..3166b70dad 100644 --- a/src/runtime/main.ml +++ b/src/runtime/main.ml @@ -158,7 +158,7 @@ let lang_doc name = let process_request s = with_toplevel (fun () -> let req = Request.create ~cue_in_metadata:None ~cue_out_metadata:None s in - match Request.resolve req 20. with + match Request.resolve req with | `Failed -> Printf.eprintf "Request resolution failed.\n"; Request.destroy req; From 4f387c265c7021bbeeb03a07aa7452b90a59bd9c Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 29 Oct 2024 15:09:39 -0500 Subject: [PATCH 080/151] Add LIQ_COMPACT_AFTER_TYPECHECK --- doc/content/language.md | 13 +++++++++++++ src/core/hooks_implementations.ml | 4 ++++ src/lang/runtime.ml | 5 ++++- src/lang/runtime.mli | 3 +++ 4 files changed, 24 insertions(+), 1 deletion(-) diff --git a/doc/content/language.md b/doc/content/language.md index 342ffda1d9..df09670002 100644 --- a/doc/content/language.md +++ b/doc/content/language.md @@ -1500,6 +1500,18 @@ that are available through your scripts. We recommend to: The default creation permissions for user cache files is: `0o600` so only the user creating them should be able to read them. You should make sure that your script permissions are also similarly restricted. +### Cache and memory usage + +One side-benefit from loading a script from cache is that the entire typechecking process is skipped. + +This can result is significant reduction in the initial memory consumption, typically down from about `375MB` to about `80MB`! + +If memory consumption is a concern but you are not sure you can cache your script, you can also set the environment variable +`LIQ_COMPACT_AFTER_TYPECHECK` to `true`. + +This will run the OCaml memory compaction algorithm after typechecking your script but before running it. This will result +in a similar memory footprint when running the script but will delay its initial startup time. + ### Cache environment variables The following environment variables control the cache behavior: @@ -1513,3 +1525,4 @@ The following environment variables control the cache behavior: - `LIQ_CACHE_USER_FILE_PERMS`: set the permissions used when creating a user cache file. Default: `0o600` - `LIQ_CACHE_MAX_DAYS`: set the maximum days a cache file can be stored before it is eligible to be deleted during the next cache maintenance pass. - `LIQ_CACHE_MAX_FILES`: set the maximum number of files in each cache directory. Older files are removed first. +- `LIQ_COMPACT_AFTER_TYPECHECK`: Set to compact memory after typechecking when caching is not available. diff --git a/src/core/hooks_implementations.ml b/src/core/hooks_implementations.ml index 28c252dba6..45bba2ef41 100644 --- a/src/core/hooks_implementations.ml +++ b/src/core/hooks_implementations.ml @@ -145,6 +145,10 @@ let cache_max_files = try int_of_string (Sys.getenv "LIQ_CACHE_MAX_FILES") with _ -> 20 let () = + (try + Liquidsoap_lang.Runtime.compact_after_typecheck := + bool_of_string (Sys.getenv "LIQ_COMPACT_AFTER_TYPECHECK") + with _ -> ()); (try Liquidsoap_lang.Cache.system_dir_perms := int_of_string (Sys.getenv "LIQ_CACHE_SYSTEM_DIR_PERMS") diff --git a/src/lang/runtime.ml b/src/lang/runtime.ml index ebf03b3068..7d1e428223 100644 --- a/src/lang/runtime.ml +++ b/src/lang/runtime.ml @@ -224,6 +224,8 @@ let report : throw exn; default ()) +let compact_after_typecheck = ref false + let type_term ?name ?stdlib ?term ?ty ?cache_dirtype ~cache ~trim ~lib parsed_term = let cached_term = @@ -273,7 +275,6 @@ let type_term ?name ?stdlib ?term ?ty ?cache_dirtype ~cache ~trim ~lib if Lazy.force Term.debug then Printf.eprintf "Checking for unused variables...\n%!"; - (* Check for unused variables, relies on types *) report ~default:(fun () -> ()) (fun ~throw () -> Term.check_unused ~throw ~lib full_term); @@ -282,6 +283,8 @@ let type_term ?name ?stdlib ?term ?ty ?cache_dirtype ~cache ~trim ~lib in if cache then Term_cache.cache ?dirtype:cache_dirtype ~trim ~parsed_term full_term; + (* Check for unused variables, relies on types *) + if !compact_after_typecheck then Gc.compact (); full_term let eval_term ?name ~toplevel ast = diff --git a/src/lang/runtime.mli b/src/lang/runtime.mli index 66748e8e98..3762f3479e 100644 --- a/src/lang/runtime.mli +++ b/src/lang/runtime.mli @@ -40,6 +40,9 @@ val type_term : Parsed_term.t -> Term.t +(* If [true], OCaml memory is compacted after typecheck. *) +val compact_after_typecheck : bool ref + (** Evaluate a term. *) val eval_term : ?name:string -> toplevel:bool -> Term.t -> Value.t From f26a670f26f8122b41ed59a7cd023068ec26e90b Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 29 Oct 2024 15:31:16 -0500 Subject: [PATCH 081/151] Add init.compact_before_start. --- doc/content/language.md | 7 +++++-- src/core/hooks_implementations.ml | 4 ---- src/lang/runtime.ml | 5 +---- src/lang/runtime.mli | 3 --- src/libs/settings.liq | 15 +++++++++++++++ 5 files changed, 21 insertions(+), 13 deletions(-) diff --git a/doc/content/language.md b/doc/content/language.md index df09670002..c92b856886 100644 --- a/doc/content/language.md +++ b/doc/content/language.md @@ -1507,7 +1507,11 @@ One side-benefit from loading a script from cache is that the entire typecheckin This can result is significant reduction in the initial memory consumption, typically down from about `375MB` to about `80MB`! If memory consumption is a concern but you are not sure you can cache your script, you can also set the environment variable -`LIQ_COMPACT_AFTER_TYPECHECK` to `true`. +`settings.init.compact_before_start` to `true`: + +```liquidsoap +settings.init.compact_before_start := true +``` This will run the OCaml memory compaction algorithm after typechecking your script but before running it. This will result in a similar memory footprint when running the script but will delay its initial startup time. @@ -1525,4 +1529,3 @@ The following environment variables control the cache behavior: - `LIQ_CACHE_USER_FILE_PERMS`: set the permissions used when creating a user cache file. Default: `0o600` - `LIQ_CACHE_MAX_DAYS`: set the maximum days a cache file can be stored before it is eligible to be deleted during the next cache maintenance pass. - `LIQ_CACHE_MAX_FILES`: set the maximum number of files in each cache directory. Older files are removed first. -- `LIQ_COMPACT_AFTER_TYPECHECK`: Set to compact memory after typechecking when caching is not available. diff --git a/src/core/hooks_implementations.ml b/src/core/hooks_implementations.ml index 45bba2ef41..28c252dba6 100644 --- a/src/core/hooks_implementations.ml +++ b/src/core/hooks_implementations.ml @@ -145,10 +145,6 @@ let cache_max_files = try int_of_string (Sys.getenv "LIQ_CACHE_MAX_FILES") with _ -> 20 let () = - (try - Liquidsoap_lang.Runtime.compact_after_typecheck := - bool_of_string (Sys.getenv "LIQ_COMPACT_AFTER_TYPECHECK") - with _ -> ()); (try Liquidsoap_lang.Cache.system_dir_perms := int_of_string (Sys.getenv "LIQ_CACHE_SYSTEM_DIR_PERMS") diff --git a/src/lang/runtime.ml b/src/lang/runtime.ml index 7d1e428223..ebf03b3068 100644 --- a/src/lang/runtime.ml +++ b/src/lang/runtime.ml @@ -224,8 +224,6 @@ let report : throw exn; default ()) -let compact_after_typecheck = ref false - let type_term ?name ?stdlib ?term ?ty ?cache_dirtype ~cache ~trim ~lib parsed_term = let cached_term = @@ -275,6 +273,7 @@ let type_term ?name ?stdlib ?term ?ty ?cache_dirtype ~cache ~trim ~lib if Lazy.force Term.debug then Printf.eprintf "Checking for unused variables...\n%!"; + (* Check for unused variables, relies on types *) report ~default:(fun () -> ()) (fun ~throw () -> Term.check_unused ~throw ~lib full_term); @@ -283,8 +282,6 @@ let type_term ?name ?stdlib ?term ?ty ?cache_dirtype ~cache ~trim ~lib in if cache then Term_cache.cache ?dirtype:cache_dirtype ~trim ~parsed_term full_term; - (* Check for unused variables, relies on types *) - if !compact_after_typecheck then Gc.compact (); full_term let eval_term ?name ~toplevel ast = diff --git a/src/lang/runtime.mli b/src/lang/runtime.mli index 3762f3479e..66748e8e98 100644 --- a/src/lang/runtime.mli +++ b/src/lang/runtime.mli @@ -40,9 +40,6 @@ val type_term : Parsed_term.t -> Term.t -(* If [true], OCaml memory is compacted after typecheck. *) -val compact_after_typecheck : bool ref - (** Evaluate a term. *) val eval_term : ?name:string -> toplevel:bool -> Term.t -> Value.t diff --git a/src/libs/settings.liq b/src/libs/settings.liq index 70698f7032..1271272782 100644 --- a/src/libs/settings.liq +++ b/src/libs/settings.liq @@ -21,7 +21,22 @@ def frame.duration = settings.frame.duration end +let settings.init.compact_before_start = + settings.make( + description= + "Run the OCaml memory compaction algorithm before starting your script. \ + This is useful when script caching is not possible but initial memory \ + consumption is a concern. This will result in a large chunk of memory \ + being freed right before starting the script. This also increases the \ + script's initial startup time.", + false + ) + # Top-level init module for convenience. # @category Settings # @flag hidden init = settings.init + +on_start( + {if settings.init.compact_before_start() then runtime.gc.compact() end} +) From 356d3f0e708c83325ee3110944105de1728c590d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 30 Oct 2024 10:34:59 -0500 Subject: [PATCH 082/151] Experimental NDI output (#4181) --- src/config/ndi_option.disabled.ml | 2 + src/config/ndi_option.enabled.ml | 1 + src/core/dune | 17 + src/core/encoder/encoder.ml | 8 + src/core/encoder/encoder.mli | 1 + src/core/encoder/encoders/ndi_encoder.ml | 43 +++ src/core/encoder/formats/ndi_format.ml | 29 ++ src/core/encoder/lang/lang_ndi.ml | 62 ++++ src/core/outputs/icecast2.ml | 2 + src/core/outputs/ndi_out.ml | 235 ++++++++++++++ src/core/tools/icecast_utils.ml | 1 + src/libs/request.liq | 6 +- src/ndi/dune | 5 + src/ndi/ndi.ml | 381 +++++++++++++++++++++++ src/ndi/ndi.mli | 81 +++++ src/runtime/build_config.ml | 1 + 16 files changed, 872 insertions(+), 3 deletions(-) create mode 100644 src/config/ndi_option.disabled.ml create mode 120000 src/config/ndi_option.enabled.ml create mode 100644 src/core/encoder/encoders/ndi_encoder.ml create mode 100644 src/core/encoder/formats/ndi_format.ml create mode 100644 src/core/encoder/lang/lang_ndi.ml create mode 100644 src/core/outputs/ndi_out.ml create mode 100644 src/ndi/dune create mode 100644 src/ndi/ndi.ml create mode 100644 src/ndi/ndi.mli diff --git a/src/config/ndi_option.disabled.ml b/src/config/ndi_option.disabled.ml new file mode 100644 index 0000000000..0397ceef84 --- /dev/null +++ b/src/config/ndi_option.disabled.ml @@ -0,0 +1,2 @@ +let detected = "no (requires ctypes-foreign)" +let enabled = false diff --git a/src/config/ndi_option.enabled.ml b/src/config/ndi_option.enabled.ml new file mode 120000 index 0000000000..34bd7cbe43 --- /dev/null +++ b/src/config/ndi_option.enabled.ml @@ -0,0 +1 @@ +noop.enabled.ml \ No newline at end of file diff --git a/src/core/dune b/src/core/dune index 74fb5b2b1d..e9e71aef0c 100644 --- a/src/core/dune +++ b/src/core/dune @@ -143,6 +143,7 @@ lang_fdkaac lang_flac lang_mp3 + lang_ndi lang_ogg lang_opus lang_source @@ -178,6 +179,8 @@ mutex_utils native_audio_converter native_video_converter + ndi_format + ndi_encoder noblank noise normalize @@ -644,6 +647,14 @@ (optional) (modules stereotool_op)) +(library + (name liquidsoap_ndi) + (libraries ndi liquidsoap_core) + (library_flags -linkall) + (wrapped false) + (optional) + (modules ndi_out)) + (library (name liquidsoap_theora) (libraries theora theora.decoder liquidsoap_core liquidsoap_ogg) @@ -732,6 +743,7 @@ lo_option mad_option memtrace_option + ndi_option ogg_option opus_option osc_option @@ -897,6 +909,11 @@ from (liquidsoap_portaudio -> portaudio_option.enabled.ml) (-> portaudio_option.disabled.ml)) + (select + ndi_option.ml + from + (liquidsoap_ndi -> ndi_option.enabled.ml) + (-> ndi_option.disabled.ml)) (select posix_time_option.ml from diff --git a/src/core/encoder/encoder.ml b/src/core/encoder/encoder.ml index 9fa62b6bd5..2700f6bc18 100644 --- a/src/core/encoder/encoder.ml +++ b/src/core/encoder/encoder.ml @@ -25,6 +25,7 @@ type format = | WAV of Wav_format.t | AVI of Avi_format.t + | NDI of Ndi_format.t | Ogg of Ogg_format.t | MP3 of Mp3_format.t | Shine of Shine_format.t @@ -61,6 +62,12 @@ let type_of_format f = | AVI a -> audio_video_type a.Avi_format.channels | MP3 m -> audio_type (if m.Mp3_format.stereo then 2 else 1) | Shine m -> audio_type m.Shine_format.channels + | NDI { audio = false; video = false } -> assert false + | NDI { audio = true; video = false } -> + audio_type (Lazy.force Frame.audio_channels) + | NDI { audio = true; video = true } -> + audio_video_type (Lazy.force Frame.audio_channels) + | NDI { audio = false; video = true } -> video_type () | Flac m -> audio_type m.Flac_format.channels | Ffmpeg m -> List.fold_left @@ -138,6 +145,7 @@ let string_of_format = function | AVI w -> Avi_format.to_string w | Ogg w -> Ogg_format.to_string w | MP3 w -> Mp3_format.to_string w + | NDI w -> Ndi_format.to_string w | Shine w -> Shine_format.to_string w | Flac w -> Flac_format.to_string w | Ffmpeg w -> Ffmpeg_format.to_string w diff --git a/src/core/encoder/encoder.mli b/src/core/encoder/encoder.mli index a6d03d22f1..49382c2bab 100644 --- a/src/core/encoder/encoder.mli +++ b/src/core/encoder/encoder.mli @@ -25,6 +25,7 @@ type format = | WAV of Wav_format.t | AVI of Avi_format.t + | NDI of Ndi_format.t | Ogg of Ogg_format.t | MP3 of Mp3_format.t | Shine of Shine_format.t diff --git a/src/core/encoder/encoders/ndi_encoder.ml b/src/core/encoder/encoders/ndi_encoder.ml new file mode 100644 index 0000000000..d362e85363 --- /dev/null +++ b/src/core/encoder/encoders/ndi_encoder.ml @@ -0,0 +1,43 @@ +(***************************************************************************** + + Liquidsoap, a programmable stream generator. + Copyright 2003-2024 Savonet team + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details, fully stated in the COPYING + file at the root of the liquidsoap distribution. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + *****************************************************************************) + +(** NDI encoder. This encoder does nothing and can only by used with `output.ndi` *) + +let encoder ~pos _ = + let error () = + Runtime_error.raise + ~pos:(match pos with Some p -> [p] | None -> []) + ~message:"The NDI encoder can only be used with `output.ndi`!" "invalid" + in + { + Encoder.insert_metadata = (fun _ -> error ()); + header = error; + hls = Encoder.dummy_hls (fun _ -> error ()); + encode = (fun _ -> error ()); + stop = error; + } + +let () = + Plug.register Encoder.plug "ndi" + ~doc:"NDI encoder. Only used with `output.ndi`." (function + | Encoder.NDI m -> Some (fun ?hls:_ ~pos _ _ -> encoder ~pos m) + | _ -> None) diff --git a/src/core/encoder/formats/ndi_format.ml b/src/core/encoder/formats/ndi_format.ml new file mode 100644 index 0000000000..60797576ec --- /dev/null +++ b/src/core/encoder/formats/ndi_format.ml @@ -0,0 +1,29 @@ +(***************************************************************************** + + Liquidsoap, a programmable stream generator. + Copyright 2003-2024 Savonet team + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details, fully stated in the COPYING + file at the root of the liquidsoap distribution. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + *****************************************************************************) + +type t = { audio : bool; video : bool } + +let to_string { audio; video } = + Printf.sprintf "%%ndi(%s)" + (String.concat "," + ((if audio then "%audio" else "%audio.none") + :: (if video then ["%video"] else ["%video.none"]))) diff --git a/src/core/encoder/lang/lang_ndi.ml b/src/core/encoder/lang/lang_ndi.ml new file mode 100644 index 0000000000..4bd3752878 --- /dev/null +++ b/src/core/encoder/lang/lang_ndi.ml @@ -0,0 +1,62 @@ +(***************************************************************************** + + Liquidsoap, a programmable stream generator. + Copyright 2003-2024 Savonet team + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details, fully stated in the COPYING + file at the root of the liquidsoap distribution. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + *****************************************************************************) + +open Ndi_format + +let type_of_encoder p = + match + List.fold_left + (fun (audio, video) -> function + | `Encoder ("audio", []) -> (true, video) + | `Encoder ("audio.none", []) -> (false, video) + | `Encoder ("video", []) -> (audio, true) + | `Encoder ("video.none", []) -> (audio, false) + | _ -> (audio, video)) + (true, true) p + with + | true, true -> Encoder.audio_video_type ~pcm_kind:Content.Audio.kind 2 + | false, true -> Encoder.video_type () + | true, false -> Encoder.audio_type ~pcm_kind:Content.Audio.kind 2 + | _ -> Lang_encoder.raise_error ~pos:None "Invalid %%ndi encoder parameter!" + +let make params = + let defaults = { audio = true; video = true } in + let ndi = + List.fold_left + (fun ndi -> function + | `Encoder ("audio", []) -> { ndi with audio = true } + | `Encoder ("audio.none", []) -> { ndi with audio = false } + | `Encoder ("video", []) -> { ndi with video = true } + | `Encoder ("video.none", []) -> { ndi with video = false } + | `Labelled (_, v) -> + Lang_encoder.raise_error ~pos:(Value.pos v) "Invalid parameter!" + | _ -> + Lang_encoder.raise_error ~pos:None + "Invalid %%ndi encoder parameter!") + defaults params + in + if (not ndi.audio) && not ndi.video then + Lang_encoder.raise_error ~pos:None + "%%ndi encoder needs at least one audio or video field!"; + Encoder.NDI ndi + +let () = Lang_encoder.register "ndi" type_of_encoder make diff --git a/src/core/outputs/icecast2.ml b/src/core/outputs/icecast2.ml index 829d78b56a..4ca6d67172 100644 --- a/src/core/outputs/icecast2.ml +++ b/src/core/outputs/icecast2.ml @@ -80,6 +80,8 @@ module Icecast = struct samplerate = Some (Lazy.force m.Fdkaac_format.samplerate); channels = Some m.Fdkaac_format.channels; } + | Encoder.NDI _ -> + { quality = None; bitrate = None; samplerate = None; channels = None } | Encoder.External m -> { quality = None; diff --git a/src/core/outputs/ndi_out.ml b/src/core/outputs/ndi_out.ml new file mode 100644 index 0000000000..2dc3926b5a --- /dev/null +++ b/src/core/outputs/ndi_out.ml @@ -0,0 +1,235 @@ +(***************************************************************************** + + Liquidsoap, a programmable stream generator. + Copyright 2003-2024 Savonet team + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details, fully stated in the COPYING + file at the root of the liquidsoap distribution. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + *****************************************************************************) + +(** Output using NDI. *) + +open Mm +open Ndi_format + +module SyncSource = Clock.MkSyncSource (struct + type t = unit + + let to_string _ = "ndi" +end) + +let sync_source = SyncSource.make () + +type sender = { handler : Ndi.Send.sender; mutable position : int64 } + +class output ~self_sync ~register_telnet ~name ~groups ~infallible ~on_start + ~on_stop ~handler ~format source start = + let sample_rate = Lazy.force Frame.audio_rate in + let frame_rate = Lazy.force Frame.video_rate in + let video_height = Lazy.force Frame.video_height in + let video_width = Lazy.force Frame.video_width in + (* Timecode is in increment of 100 ns *) + let timecode_base = + Int64.div 10_000_000L (Int64.of_int (Lazy.force Frame.main_rate)) + in + let clock_audio, clock_video = + match (self_sync, format.audio, format.video) with + | false, _, _ -> (false, false) + | true, _, true -> (false, true) + | true, true, _ -> (true, false) + | _ -> assert false + in + object (self) + inherit + Output.output + ~register_telnet ~infallible ~on_start ~on_stop ~name:"ndi" + ~output_kind:"output.ndi" source start + + val mutable sender = None + + method! self_sync = + if self_sync then + (`Dynamic, if sender <> None then Some sync_source else None) + else (`Static, None) + + method get_sender = + match sender with + | Some s -> s + | None -> + let handler = + Ndi.Send.init ~clock_audio ~clock_video ?groups ?name handler + in + let s = { handler; position = 0L } in + sender <- Some s; + s + + method start = ignore self#get_sender + + method stop = + match sender with + | Some { handler } -> + Ndi.Send.destroy handler; + sender <- None + | None -> () + + method private send_audio_frame ~timecode ~sender frame = + let pcm = AFrame.pcm frame in + let channels = Array.length pcm in + let samples = Audio.length pcm in + let data = + Bigarray.Array1.create Bigarray.float32 Bigarray.c_layout + (samples * channels) + in + Audio.FLTP.of_audio ~src:pcm ~src_offset:0 ~dst:data ~dst_offset:0 + ~len:samples ~stride:samples; + let audio_frame = + { + Ndi.Frame.Audio.sample_rate; + channels; + samples; + timecode = Some timecode; + data = `Fltp { Ndi.Frame.Audio.data; stride = samples * 4 }; + metadata = None; + timestamp = None; + } + in + Ndi.Send.send_audio sender.handler audio_frame + + method private send_video_frame ~timecode ~sender frame = + let buf = VFrame.data frame in + List.iter + (fun (pos, img) -> + let img = + img + (* TODO: we could scale instead of aggressively changing the viewport *) + |> Video.Canvas.Image.viewport video_width video_height + |> Video.Canvas.Image.render ~transparent:false + in + let y, u, v = Image.YUV420.data img in + let y_dim = Bigarray.Array1.dim y in + let u_dim = Bigarray.Array1.dim u in + let v_dim = Bigarray.Array1.dim v in + let stride = Image.YUV420.y_stride img in + let data = + Bigarray.Array1.create Bigarray.int8_unsigned Bigarray.c_layout + (y_dim + u_dim + v_dim) + in + Bigarray.Array1.blit y (Bigarray.Array1.sub data 0 y_dim); + Bigarray.Array1.blit u (Bigarray.Array1.sub data y_dim u_dim); + Bigarray.Array1.blit v + (Bigarray.Array1.sub data (y_dim + u_dim) v_dim); + let video_frame = + { + Ndi.Frame.Video.xres = video_width; + yres = video_height; + frame_rate_N = frame_rate; + frame_rate_D = 1; + picture_aspect_ratio = None; + format = `Progressive; + timecode = + Some Int64.(add timecode (mul (of_int pos) timecode_base)); + data = `I420 { Ndi.Frame.Video.data; stride }; + metadata = None; + timestamp = None; + } + in + Ndi.Send.send_video sender.handler video_frame) + buf.Content.Video.data + + method send_frame frame = + let sender = self#get_sender in + let timecode = Int64.mul sender.position timecode_base in + if format.audio then self#send_audio_frame ~timecode ~sender frame; + if format.video then self#send_video_frame ~timecode ~sender frame; + sender.position <- + Int64.add sender.position (Int64.of_int (Frame.position frame)) + + method! reset = () + end + +let _ = + let return_t = Lang.univ_t () in + Lang.add_operator ~base:Modules.output "ndi" ~flags:[`Experimental] + (Output.proto + @ [ + ( "self_sync", + Lang.bool_t, + Some (Lang.bool false), + Some "Use the dedicated NDI clock." ); + ( "library_file", + Lang.string_t, + None, + Some "Path to the shared library file." ); + ( "name", + Lang.nullable_t Lang.string_t, + Some Lang.null, + Some "NDI sender name" ); + ( "groups", + Lang.nullable_t Lang.string_t, + Some Lang.null, + Some "NDI sender groups" ); + ( "", + Lang.format_t return_t, + None, + Some "Encoding format. Only the `%ndi` encoder is allowed here!" ); + ("", Lang.source_t return_t, None, None); + ]) + ~category:`Output ~meth:Output.meth ~descr:"Output stream to NDI" ~return_t + (fun p -> + let self_sync = Lang.to_bool (List.assoc "self_sync" p) in + let lib = Lang.to_string (List.assoc "library_file" p) in + let lib = Utils.check_readable ~pos:(Lang.pos p) lib in + let handler = + try Ndi.init ~filename:lib () with + | Ndi.Library_not_found -> + Runtime_error.raise ~pos:(Lang.pos p) + ~message:"Invalid ndi library" "invalid" + | Ndi.Library_initialized f -> + Runtime_error.raise ~pos:(Lang.pos p) + ~message: + (Printf.sprintf + "Ndi already initialized with a different library: %s" + (Lang_string.quote_string f)) + "invalid" + in + let name = Lang.to_valued_option Lang.to_string (List.assoc "name" p) in + let groups = + Lang.to_valued_option Lang.to_string (List.assoc "groups" p) + in + let infallible = not (Lang.to_bool (List.assoc "fallible" p)) in + let register_telnet = Lang.to_bool (List.assoc "register_telnet" p) in + let start = Lang.to_bool (List.assoc "start" p) in + let on_start = + let f = List.assoc "on_start" p in + fun () -> ignore (Lang.apply f []) + in + let on_stop = + let f = List.assoc "on_stop" p in + fun () -> ignore (Lang.apply f []) + in + let format = + match Lang.to_format (Lang.assoc "" 1 p) with + | NDI n -> n + | _ -> + Runtime_error.raise ~pos:(Lang.pos p) + ~message:"Only the %ndi encoder is allowed for `output.ndi`!" + "invalid" + in + let source = Lang.assoc "" 2 p in + (new output + ~self_sync ~name ~groups ~infallible ~register_telnet ~on_start + ~on_stop ~handler ~format source start + :> Output.output)) diff --git a/src/core/tools/icecast_utils.ml b/src/core/tools/icecast_utils.ml index ee639a70a3..673b6e3171 100644 --- a/src/core/tools/icecast_utils.ml +++ b/src/core/tools/icecast_utils.ml @@ -171,6 +171,7 @@ module Icecast_v (M : Icecast_t) = struct | Some v -> ffmpeg_mime_of_format v) | Encoder.FdkAacEnc _ -> Some aac | Encoder.External _ -> None + | Encoder.NDI _ -> None | Encoder.Flac _ -> Some flac | Encoder.WAV _ -> Some wav | Encoder.AVI _ -> Some avi diff --git a/src/libs/request.liq b/src/libs/request.liq index 77bcd18dae..740151bb7a 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -28,7 +28,7 @@ end # @param ~native Use native implementation, when available. # @param ~queue Initial queue of requests. # @param ~thread_queue Queue used to resolve requests. -# @param ~timeout Timeout (in sec.) for a single download. +# @param ~timeout Timeout (in sec.) to resolve the request. # @method add This method is internal and should not be used. Consider using `push` instead. # @method push Push a request on the request queue. # @method length Length of the queue. @@ -276,7 +276,7 @@ end # @category Source / Input # @param ~prefetch How many requests should be queued in advance. # @param ~thread_queue Queue used to resolve requests. -# @param ~timeout Timeout (in sec.) for a single download. +# @param ~timeout Timeout (in sec.) to resolve the request. # @param ~fallible Enforce fallibility of the request. # @param r Request def request.single( @@ -380,7 +380,7 @@ end # static, and time is not. # @category Source / Input # @param ~prefetch How many requests should be queued in advance. -# @param ~timeout Timeout (in sec.) for a single download. +# @param ~timeout Timeout (in sec.) to resolve the request. # @param ~fallible Enforce fallibility of the request. # @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. # @param ~cue_out_metadata Metadata for cue out points. Disabled if `null`. diff --git a/src/ndi/dune b/src/ndi/dune new file mode 100644 index 0000000000..de5ac7caf0 --- /dev/null +++ b/src/ndi/dune @@ -0,0 +1,5 @@ +(library + (optional) + (name ndi) + (modules ndi) + (libraries ctypes ctypes.foreign)) diff --git a/src/ndi/ndi.ml b/src/ndi/ndi.ml new file mode 100644 index 0000000000..c6b4f57ea7 --- /dev/null +++ b/src/ndi/ndi.ml @@ -0,0 +1,381 @@ +open Ctypes +open Foreign + +module type Config = sig + val filename : string +end + +exception Library_not_found +exception Library_initialized of string + +type source = { source_name : string; source_url : string } + +let strlen = foreign "strlen" (ptr char @-> returning int) + +(* +let malloc = foreign "malloc" (size_t @-> returning (ptr void)) + +let malloc typ = + let ptr = malloc (Unsigned.Size_t.of_int (sizeof typ)) in + if is_null ptr then failwith "out of memory!"; + from_voidp typ ptr + +let memcpy = + foreign "memcpy" (ptr void @-> ptr void @-> size_t @-> returning void) + +let memcpy : 'a. 'a ptr -> 'a ptr -> unit = + fun dst src -> + memcpy (to_voidp dst) (to_voidp src) + (Unsigned.Size_t.of_int (sizeof (reference_type dst))) +*) + +let opt_str_ptr = function + | None -> from_voidp char null + | Some s -> + let s = CArray.of_string s in + CArray.start s + +let opt_int64 = function None -> Int64.max_int | Some i -> i +let source_struct : [ `Source ] structure typ = structure "NDIlib_source_t" +let source_p_ndi_name = field source_struct "p_ndi_name" (ptr char) +let source_p_url_address = field source_struct "p_url_address" (ptr char) +let () = seal source_struct + +let source_name source = + let name = getf !@source source_p_ndi_name in + if is_null name then "" else string_from_ptr name ~length:(strlen name) + +let source_url source = + let url = getf !@source source_p_url_address in + if is_null url then "" else string_from_ptr url ~length:(strlen url) + +let find_create_struct : [ `Find_create ] structure typ = + structure "NDIlib_find_create_t" + +let find_create_show_local_sources = + field find_create_struct "show_local_sources" bool + +let find_create_p_groups = field find_create_struct "p_groups" (ptr char) +let find_create_p_extra_ips = field find_create_struct "p_extra_ips" (ptr char) +let () = seal find_create_struct +let find_instance = typedef void "NDIlib_find_instance_t" + +let send_create_struct : [ `Send_create ] structure typ = + structure "NDIlib_send_create_t" + +let send_create_p_ndi_name = field send_create_struct "p_ndi_name" (ptr char) +let send_create_p_groups = field send_create_struct "p_groups" (ptr char) +let send_create_clock_video = field send_create_struct "clock_video" bool +let send_create_clock_audio = field send_create_struct "clock_audio" bool +let () = seal send_create_struct +let send_instance = typedef void "NDIlib_send_instance_t" + +module Frame = struct + (* + type frame_type = + [ `None | `Video | `Audio | `Metadata | `Error | `Status_change ] + + let frame_type = function + | `None -> 0 + | `Video -> 1 + | `Audio -> 2 + | `Metadata -> 3 + | `Error -> 4 + | `Status_change -> 100 +*) + + let four_cc a b c d = + Char.code a + lor (Char.code b lsl 8) + lor (Char.code c lsl 16) + lor (Char.code d lsl 24) + + module Video = struct + type i420 = { + data : + (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t; + stride : int; + } + + type data = [ `I420 of i420 ] + type format = [ `Progressive ] + + type t = { + xres : int; + yres : int; + frame_rate_N : int; + frame_rate_D : int; + picture_aspect_ratio : float option; + format : format; + timecode : int64 option; + data : data; + metadata : string option; + timestamp : int64 option; + } + + let four_cc_code = function `I420 -> four_cc 'I' '4' '2' '0' + let format_code = function `Progressive -> 1 + + let video_frame_struct : [ `Video_frame_v2 ] structure typ = + structure "NDIlib_video_frame_v2_t" + + let xres_field = field video_frame_struct "xres" int + let yres_field = field video_frame_struct "yres" int + let four_cc_field = field video_frame_struct "FourCC" int + let frame_rate_N_field = field video_frame_struct "frame_rate_N" int + let frame_rate_D_field = field video_frame_struct "frame_rate_D" int + + let picture_aspect_ratio_field = + field video_frame_struct "picture_aspect_ratio" float + + let format_field = field video_frame_struct "format" int + let timecode_field = field video_frame_struct "timecode" int64_t + let data_field = field video_frame_struct "data" (ptr uint8_t) + + let line_stride_in_bytes_field = + field video_frame_struct "line_stride_in_bytes" int + + let metadata_field = field video_frame_struct "metadata" (ptr char) + let timestamp_field = field video_frame_struct "timestamp" int64_t + let () = seal video_frame_struct + + let frame + { + xres; + yres; + frame_rate_N; + frame_rate_D; + picture_aspect_ratio; + format; + timecode; + data; + metadata; + timestamp; + } = + let frame = make video_frame_struct in + setf frame xres_field xres; + setf frame yres_field yres; + setf frame frame_rate_N_field frame_rate_N; + setf frame frame_rate_D_field frame_rate_D; + setf frame picture_aspect_ratio_field + (Option.value ~default:0. picture_aspect_ratio); + setf frame format_field (format_code format); + setf frame timecode_field (opt_int64 timecode); + setf frame metadata_field (opt_str_ptr metadata); + setf frame timestamp_field (opt_int64 timestamp); + + let four_cc, data, stride = + match data with + | `I420 { data; stride } -> + let four_cc = four_cc_code `I420 in + let data = + coerce (ptr int) (ptr uint8_t) (bigarray_start array1 data) + in + (four_cc, data, stride) + in + setf frame four_cc_field four_cc; + setf frame data_field data; + setf frame line_stride_in_bytes_field stride; + + frame + end + + module Audio = struct + type fltp = { + data : (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t; + stride : int; + } + + type data = [ `Fltp of fltp ] + + let four_cc_code = function `Fltp -> four_cc 'F' 'L' 'T' 'p' + + type t = { + sample_rate : int; + channels : int; + samples : int; + timecode : int64 option; + data : data; + metadata : string option; + timestamp : int64 option; + } + + let audio_frame_struct : [ `Audio_frame_v3 ] structure typ = + structure "NDIlib_audio_frame_v3_t" + + let sample_rate_field = field audio_frame_struct "sample_rate" int + let no_channels_field = field audio_frame_struct "no_channels" int + let no_samples_field = field audio_frame_struct "no_samples" int + let timecode_field = field audio_frame_struct "timecode" int64_t + let four_cc_field = field audio_frame_struct "FourCC" int + let data_field = field audio_frame_struct "data" (ptr uint8_t) + + let channel_stride_in_bytes_field = + field audio_frame_struct "channel_stride_in_bytes" int + + let p_metadata_field = field audio_frame_struct "p_metadata" (ptr char) + let timestamp_field = field audio_frame_struct "timestamp" int64_t + let () = seal audio_frame_struct + + let frame + { sample_rate; channels; samples; timecode; data; metadata; timestamp } + = + let frame = make audio_frame_struct in + setf frame sample_rate_field sample_rate; + setf frame no_channels_field channels; + setf frame no_samples_field samples; + setf frame timecode_field (opt_int64 timecode); + let four_cc, data, stride = + match data with + | `Fltp { data; stride } -> + let four_cc = four_cc_code `Fltp in + let data = + coerce (ptr float) (ptr uint8_t) (bigarray_start array1 data) + in + (four_cc, data, stride) + in + setf frame four_cc_field four_cc; + setf frame data_field data; + setf frame channel_stride_in_bytes_field stride; + + setf frame p_metadata_field (opt_str_ptr metadata); + setf frame timestamp_field (opt_int64 timestamp); + frame + end +end + +module C (Conf : Config) = struct + let lib = + try Dl.dlopen ~filename:Conf.filename ~flags:[Dl.RTLD_NOW] + with _ -> raise Library_not_found + + let foreign = foreign ~from:lib + let initialize = foreign "NDIlib_initialize" (void @-> returning void) + let destroy = foreign "NDIlib_destroy" (void @-> returning void) + let version = foreign "NDIlib_version" (void @-> returning string) + + let find_create_v2 = + foreign "NDIlib_find_create_v2" + (ptr find_create_struct @-> returning (ptr_opt find_instance)) + + let find_destroy = + foreign "NDIlib_find_destroy" (ptr find_instance @-> returning void) + + let find_wait_for_sources = + foreign "NDIlib_find_wait_for_sources" + (ptr find_instance @-> uint32_t @-> returning bool) + + let get_current_sources = + foreign "NDIlib_find_get_current_sources" + (ptr find_instance @-> ptr uint32_t @-> returning (ptr source_struct)) + + let find ?(show_local_sources = true) ?groups ?extra_ips ?(timeout = 500) () = + let find_create = make find_create_struct in + setf find_create find_create_show_local_sources show_local_sources; + setf find_create find_create_p_groups (opt_str_ptr groups); + setf find_create find_create_p_extra_ips (opt_str_ptr extra_ips); + match find_create_v2 (addr find_create) with + | None -> failwith "Error while creating find_create instance!" + | Some f -> + Gc.finalise find_destroy f; + while + not (find_wait_for_sources f (Unsigned.UInt32.of_int timeout)) + do + () + done; + let nb_sources = allocate uint32_t (Unsigned.UInt32.of_int 0) in + let source = get_current_sources f nb_sources in + let nb_sources = Unsigned.UInt32.to_int !@nb_sources in + let rec get pos sources = + if pos < nb_sources then ( + let s = source +@ pos in + get (pos + 1) + ({ source_name = source_name s; source_url = source_url s } + :: sources)) + else sources + in + get 0 [] + + let send_create = + foreign "NDIlib_send_create" + (ptr send_create_struct @-> returning (ptr send_instance)) + + let send_destroy = + foreign "NDIlib_send_destroy" (ptr send_instance @-> returning void) + + let send_create ?groups ?(clock_video = false) ?(clock_audio = false) ?name () + = + let send_create_settings = make send_create_struct in + setf send_create_settings send_create_p_ndi_name (opt_str_ptr name); + setf send_create_settings send_create_p_groups (opt_str_ptr groups); + setf send_create_settings send_create_clock_video clock_video; + setf send_create_settings send_create_clock_audio clock_audio; + let send_instance = send_create (addr send_create_settings) in + send_instance + + let send_audio_v3 = + foreign "NDIlib_send_send_audio_v3" + (ptr void @-> ptr Frame.Audio.audio_frame_struct @-> returning void) + + let send_video_v2 = + foreign "NDIlib_send_send_video_v2" + (ptr void @-> ptr Frame.Video.video_frame_struct @-> returning void) +end + +module type C = module type of C (struct + let filename = "foo" +end) + +type t = { _module : (module C) } + +let initialized = Atomic.make None + +let init ~filename () = + (match Atomic.get initialized with + | Some f when f <> filename -> raise (Library_initialized f) + | _ -> Atomic.set initialized (Some filename)); + try + let module C = C (struct + let filename = filename + end) in + C.initialize (); + let _module = (module C : C) in + let finalise _ = C.destroy () in + let handler = { _module = (module C : C) } in + Gc.finalise finalise handler; + handler + with _ -> raise Library_not_found + +let version { _module } = + let module C = (val _module : C) in + C.version () + +let find ?show_local_sources ?groups ?extra_ips ?timeout { _module } = + let module C = (val _module : C) in + let extra_ips = Option.map (fun ips -> String.concat "," ips) extra_ips in + C.find ?show_local_sources ?groups ?extra_ips ?timeout () + +module Send = struct + type sender = { sender_module : (module C); sender : unit ptr } + + let init ?clock_audio ?clock_video ?groups ?name { _module } = + let module C = (val _module : C) in + { + sender_module = _module; + sender = C.send_create ?clock_audio ?clock_video ?groups ?name (); + } + + let send_audio { sender_module; sender } frame = + let module C = (val sender_module : C) in + let frame = Frame.Audio.frame frame in + C.send_audio_v3 sender (addr frame) + + let send_video { sender_module; sender } frame = + let module C = (val sender_module : C) in + let frame = Frame.Video.frame frame in + C.send_video_v2 sender (addr frame) + + let destroy { sender_module; sender } = + let module C = (val sender_module : C) in + C.send_destroy sender +end diff --git a/src/ndi/ndi.mli b/src/ndi/ndi.mli new file mode 100644 index 0000000000..73c885a638 --- /dev/null +++ b/src/ndi/ndi.mli @@ -0,0 +1,81 @@ +(** Binding to the proprietary NDI library. + Please refer to the library's documentation for details + regarding this binding's functions. *) + +type t +type source = { source_name : string; source_url : string } + +exception Library_not_found +exception Library_initialized of string + +val init : filename:string -> unit -> t +val version : t -> string + +val find : + ?show_local_sources:bool -> + ?groups:string -> + ?extra_ips:string list -> + ?timeout:int -> + t -> + source list + +module Frame : sig + module Audio : sig + type fltp = { + data : (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t; + stride : int; + } + + type data = [ `Fltp of fltp ] + + type t = { + sample_rate : int; + channels : int; + samples : int; + timecode : int64 option; + data : data; + metadata : string option; + timestamp : int64 option; + } + end + + module Video : sig + type i420 = { + data : + (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t; + stride : int; + } + + type data = [ `I420 of i420 ] + type format = [ `Progressive ] + + type t = { + xres : int; + yres : int; + frame_rate_N : int; + frame_rate_D : int; + picture_aspect_ratio : float option; + format : format; + timecode : int64 option; + data : data; + metadata : string option; + timestamp : int64 option; + } + end +end + +module Send : sig + type sender + + val init : + ?clock_audio:bool -> + ?clock_video:bool -> + ?groups:string -> + ?name:string -> + t -> + sender + + val send_audio : sender -> Frame.Audio.t -> unit + val send_video : sender -> Frame.Video.t -> unit + val destroy : sender -> unit +end diff --git a/src/runtime/build_config.ml b/src/runtime/build_config.ml index d3291606b5..20495b0da7 100644 --- a/src/runtime/build_config.ml +++ b/src/runtime/build_config.ml @@ -86,6 +86,7 @@ let build_config = - AO : %{Ao_option.detected} - FFmpeg : %{Ffmpeg_option.detected} - JACK : %{Bjack_option.detected} + - NDI : %{Ndi_option.detected} - OSS : %{Oss_option.detected} - Portaudio : %{Portaudio_option.detected} - Pulseaudio : %{Pulseaudio_option.detected} From 06103d491a54e5b001daa7ac253bd6b4d2a10e3f Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 31 Oct 2024 08:28:20 -0500 Subject: [PATCH 083/151] Restore memetrace build config. --- src/core/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/dune b/src/core/dune index e9e71aef0c..5a5c2c5a1d 100644 --- a/src/core/dune +++ b/src/core/dune @@ -882,7 +882,7 @@ (select memtrace_option.ml from - (liquidsoap_memtrace -> memtrace_option.enabled.ml) + (memtrace -> memtrace_option.enabled.ml) (-> memtrace_option.disabled.ml)) (select ogg_option.ml From 643ce293660d334a0e507b18c121e8b3995ee79d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 31 Oct 2024 10:09:34 -0500 Subject: [PATCH 084/151] Prevent error here. --- src/core/clock.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/clock.ml b/src/core/clock.ml index 36ff5d4393..4050dac02f 100644 --- a/src/core/clock.ml +++ b/src/core/clock.ml @@ -212,7 +212,7 @@ let _sync ?(pending = false) x = | `Started { sync } -> (sync :> sync_mode) let sync c = _sync (Unifier.deref c) -let cleanup_source s = s#force_sleep +let cleanup_source s = try s#force_sleep with _ -> () let clocks = Queue.create () let rec _cleanup ~clock { outputs; passive_sources; active_sources } = From 63abaa4dc3f9a19ce45dec4bfce796d389af2e95 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 1 Nov 2024 17:15:09 -0500 Subject: [PATCH 085/151] Don't retain passive clocks at top-level (#4198) --- src/core/clock.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/clock.ml b/src/core/clock.ml index 4050dac02f..1b98d152c2 100644 --- a/src/core/clock.ml +++ b/src/core/clock.ml @@ -527,7 +527,7 @@ let create ?(stack = []) ?on_error ?(id = "generic") ?(sub_ids = []) on_error = on_error_queue; } in - Queue.push clocks c; + if sync <> `Passive then Queue.push clocks c; c let time c = From 5c0caaa6644a5fed7c7bab7a45b57df6bcb69794 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 3 Nov 2024 10:33:28 -0600 Subject: [PATCH 086/151] Single: always return a fresh source. (#4200) --- src/libs/request.liq | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/src/libs/request.liq b/src/libs/request.liq index 740151bb7a..02288e1c93 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -312,7 +312,6 @@ def request.single( end static_request = ref(null()) - done = ref(false) def on_wake_up() = if @@ -349,21 +348,13 @@ def request.single( end def next() = - if - done() - then - null() - else - done := true - - def next() = - static_request() ?? getter.get(r) - end - - s = request.dynamic(prefetch=prefetch, thread_queue=thread_queue, next) - if infallible then s.set_queue([next()]) end - s + def next() = + static_request() ?? getter.get(r) end + + s = request.dynamic(prefetch=prefetch, thread_queue=thread_queue, next) + if infallible then s.set_queue([next()]) end + s end s = From 1882a1f2be8aaac5fe1b67c8194fdeea368361f3 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 9 Nov 2024 16:31:59 -0600 Subject: [PATCH 087/151] Better source telnet commands. (#4206) --- src/core/clock.ml | 4 +- src/core/lang_source.ml | 31 +++++++ src/core/source.ml | 20 ++++- src/core/source.mli | 5 ++ src/libs/extra/audio.liq | 18 ++-- src/libs/extra/server.liq | 40 +++------ src/libs/playlist.liq | 180 ++++++++++++++++++-------------------- src/libs/request.liq | 107 +++++++++++----------- 8 files changed, 207 insertions(+), 198 deletions(-) diff --git a/src/core/clock.ml b/src/core/clock.ml index 1b98d152c2..8002883d8f 100644 --- a/src/core/clock.ml +++ b/src/core/clock.ml @@ -259,9 +259,9 @@ let unify = (Queue.push clock'.pending_activations); Queue.flush_iter clock.sub_clocks (Queue.push clock'.sub_clocks); Queue.flush_iter clock.on_error (Queue.push clock'.on_error); - Queue.filter clocks (fun el -> el != c); Unifier.(clock.id <-- clock'.id); - Unifier.(c <-- c') + Unifier.(c <-- c'); + Queue.filter clocks (fun el -> sync el <> `Passive && el != c) in fun ~pos c c' -> let _c = Unifier.deref c in diff --git a/src/core/lang_source.ml b/src/core/lang_source.ml index 53fe0231ac..b34070636d 100644 --- a/src/core/lang_source.ml +++ b/src/core/lang_source.ml @@ -188,6 +188,37 @@ let source_methods = fun s -> val_fun [] (fun _ -> match s#last_metadata with None -> null | Some m -> metadata m) ); + ( "register_command", + ( [], + fun_t + [ + (true, "usage", Lang.nullable_t Lang.string_t); + (false, "description", Lang.string_t); + (false, "", Lang.string_t); + (false, "", Lang.fun_t [(false, "", Lang.string_t)] Lang.string_t); + ] + unit_t ), + "Register a server command for this source. Command is registered under \ + the source's id namespace when it gets up and de-registered when it \ + gets down.", + fun s -> + val_fun + [ + ("usage", "usage", Some Lang.null); + ("description", "description", None); + ("", "", None); + ("", "", None); + ] + (fun p -> + let usage = + Lang.to_valued_option Lang.to_string (List.assoc "usage" p) + in + let descr = Lang.to_string (List.assoc "description" p) in + let command = Lang.to_string (Lang.assoc "" 1 p) in + let f = Lang.assoc "" 2 p in + let f x = Lang.to_string (Lang.apply f [("", Lang.string x)]) in + s#register_command ?usage ~descr command f; + unit) ); ( "on_metadata", ([], fun_t [(false, "", fun_t [(false, "", metadata_t)] unit_t)] unit_t), "Call a given handler on metadata packets.", diff --git a/src/core/source.ml b/src/core/source.ml index abe9b4a222..3355c6ab4b 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -24,6 +24,8 @@ open Mm exception Unavailable +module Queue = Liquidsoap_lang.Queues.Queue + type streaming_state = [ `Pending | `Unavailable | `Ready of unit -> unit | `Done of Frame.t ] @@ -65,8 +67,8 @@ type watcher = { let source_log = Log.make ["source"] -let sleep s = - source_log#info "Source %s gets down." s#id; +let finalise s = + source_log#debug "Source %s is collected." s#id; try s#sleep with e -> let bt = Printexc.get_backtrace () in @@ -132,6 +134,18 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = method virtual fallible : bool method source_type : source_type = `Passive + val mutable registered_commands = Queue.create () + + method register_command ?usage ~descr name cmd = + self#on_wake_up (fun () -> + let ns = [self#id] in + Server.add ~ns ?usage ~descr name cmd; + Queue.push registered_commands (ns, name)) + + initializer + self#on_sleep (fun () -> + Queue.flush_iter registered_commands (fun (ns, name) -> + Server.remove ~ns name)) method active = match self#source_type with @@ -246,7 +260,7 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = | _ -> self#force_sleep initializer - Gc.finalise sleep self; + Gc.finalise finalise self; self#on_sleep (fun () -> self#iter_watchers (fun w -> w.sleep ())) (** Streaming *) diff --git a/src/core/source.mli b/src/core/source.mli index 71cc42efaa..8fed0c791b 100644 --- a/src/core/source.mli +++ b/src/core/source.mli @@ -219,6 +219,11 @@ class virtual source : method reset_last_metadata_on_track : bool method set_reset_last_metadata_on_track : bool -> unit + (** Register a server command. The command is registered when the source + wakes up under its own id as namespace and deregistered when it goes down. *) + method register_command : + ?usage:string -> descr:string -> string -> (string -> string) -> unit + (** Register a callback to be called on new metadata *) method on_metadata : (Frame.metadata -> unit) -> unit diff --git a/src/libs/extra/audio.liq b/src/libs/extra/audio.liq index e33ffc4033..bd1647e14f 100644 --- a/src/libs/extra/audio.liq +++ b/src/libs/extra/audio.liq @@ -401,8 +401,7 @@ def mix(~id=null(), ~register_server_commands=true, sources) = remaining=#{source.remaining(input.source)}" end - server.register( - namespace=source.id(s), + s.register_command( description= "Skip current track on all enabled sources.", "skip", @@ -418,8 +417,7 @@ def mix(~id=null(), ~register_server_commands=true, sources) = end ) - server.register( - namespace=source.id(s), + s.register_command( description= "Set volume for a given source.", usage= @@ -438,8 +436,7 @@ def mix(~id=null(), ~register_server_commands=true, sources) = end ) - server.register( - namespace=source.id(s), + s.register_command( description= "Enable/disable a source.", usage= @@ -458,8 +455,7 @@ def mix(~id=null(), ~register_server_commands=true, sources) = end ) - server.register( - namespace=source.id(s), + s.register_command( description= "Enable/disable automatic stop at the end of track.", usage= @@ -478,8 +474,7 @@ def mix(~id=null(), ~register_server_commands=true, sources) = end ) - server.register( - namespace=source.id(s), + s.register_command( description= "Display current status.", "status", @@ -493,8 +488,7 @@ def mix(~id=null(), ~register_server_commands=true, sources) = end ) - server.register( - namespace=source.id(s), + s.register_command( description= "Print the list of input sources.", "inputs", diff --git a/src/libs/extra/server.liq b/src/libs/extra/server.liq index 1e9c74ea0d..ae8095d619 100644 --- a/src/libs/extra/server.liq +++ b/src/libs/extra/server.liq @@ -10,19 +10,12 @@ def server.rms(~id=null(), s) = "#{rms}" end - s.on_wake_up( - memoize( - { - server.register( - namespace="#{source.id(s)}", - description= - "Return the current RMS of the source.", - usage="rms", - "rms", - rms - ) - } - ) + s.register_command( + description= + "Return the current RMS of the source.", + usage="rms", + "rms", + rms ) s @@ -50,20 +43,13 @@ def server.insert_metadata(~id=null(), s) = end end - s.on_wake_up( - memoize( - { - server.register( - namespace="#{source.id(s)}", - description= - "Insert a metadata chunk.", - usage= - "insert key1=\"val1\",key2=\"val2\",..", - "insert", - insert - ) - } - ) + s.register_command( + description= + "Insert a metadata chunk.", + usage= + "insert key1=\"val1\",key2=\"val2\",..", + "insert", + insert ) s diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq index 8502d2b802..d0e51e418f 100644 --- a/src/libs/playlist.liq +++ b/src/libs/playlist.liq @@ -675,108 +675,96 @@ def replaces playlist( s.on_shutdown(watcher_shutdown) end - s.on_wake_up( - memoize( - { - let id = source.id(s) - - # Set up telnet commands - server.register( - namespace=id, - description= - "Skip current song in the playlist.", - usage="skip", - "skip", - fun (_) -> - begin - s.skip() - "OK" - end - ) + # Set up telnet commands + s.register_command( + description= + "Skip current song in the playlist.", + usage="skip", + "skip", + fun (_) -> + begin + s.skip() + "OK" + end + ) - server.register( - namespace=id, - description= - "Return up to 10 next URIs to be played.", - usage="next", - "next", - fun (n) -> - begin - n = max(10, int_of_string(default=10, n)) - requests = - list.fold( - (fun (cur, el) -> list.length(cur) < n ? [...cur, el] : cur ), - [], - s.queue() - ) - - string.concat( - separator="\n", - list.map( - ( - fun (r) -> - begin - m = request.metadata(r) - get = fun (lbl) -> list.assoc(default="?", lbl, m) - status = get("status") - uri = get("initial_uri") - "[#{status}] #{uri}" - end - ), - requests - ) - ) - end - ) + s.register_command( + description= + "Return up to 10 next URIs to be played.", + usage="next", + "next", + fun (n) -> + begin + n = max(10, int_of_string(default=10, n)) + requests = + list.fold( + (fun (cur, el) -> list.length(cur) < n ? [...cur, el] : cur ), + [], + s.queue() + ) - server.register( - namespace=id, - description= - "Reload the playlist, unless already being loaded.", - usage="reload", - "reload", - fun (_) -> - begin - s.reload() - "OK" - end + string.concat( + separator="\n", + list.map( + ( + fun (r) -> + begin + m = request.metadata(r) + get = fun (lbl) -> list.assoc(default="?", lbl, m) + status = get("status") + uri = get("initial_uri") + "[#{status}] #{uri}" + end + ), + requests + ) ) + end + ) - def uri_cmd(uri') = - if - uri' == "" - then - playlist_uri() - else - if - reload_mode == "watch" - then - log.important( - label=id, - "Warning: the watched file is not updated for now when changing \ - the uri!" - ) - end - - # TODO - playlist_uri := uri' - s.reload(uri=uri') - "OK" - end - end + s.register_command( + description= + "Reload the playlist, unless already being loaded.", + usage="reload", + "reload", + fun (_) -> + begin + s.reload() + "OK" + end + ) - server.register( - namespace=id, - description= - "Print playlist URI if called without an argument, otherwise set a \ - new one and load it.", - usage= - "uri []", - "uri", - uri_cmd + def uri_cmd(uri') = + if + uri' == "" + then + playlist_uri() + else + if + reload_mode == "watch" + then + log.important( + label=id, + "Warning: the watched file is not updated for now when changing the \ + uri!" ) - } - ) + end + + # TODO + playlist_uri := uri' + s.reload(uri=uri') + "OK" + end + end + + s.register_command( + description= + "Print playlist URI if called without an argument, otherwise set a new one \ + and load it.", + usage= + "uri []", + "uri", + uri_cmd ) s diff --git a/src/libs/request.liq b/src/libs/request.liq index 02288e1c93..ad1691b9a4 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -149,6 +149,7 @@ def request.queue( source.set_name(s, "request.queue") fetch := s.fetch + if interactive then @@ -158,67 +159,57 @@ def request.queue( "#{request.id(r)}" end - s.on_wake_up( - memoize( - { - server.register( - namespace=source.id(s), - description= - "Flush the queue and skip the current track", - "flush_and_skip", - fun (_) -> - try - s.set_queue([]) - s.skip() - "Done." - catch err do - "Error while flushing and skipping source: #{err}" - end - ) - - server.register( - namespace=source.id(s), - description= - "Push a new request in the queue.", - usage= - "push ", - "push", - push - ) + s.register_command( + description= + "Flush the queue and skip the current track", + "flush_and_skip", + fun (_) -> + try + s.set_queue([]) + s.skip() + "Done." + catch err do + "Error while flushing and skipping source: #{err}" + end + ) - def show_queue(_) = - queue = s.queue() - string.concat( - separator= - " ", - list.map(fun (r) -> string(request.id(r)), queue) - ) - end - - server.register( - namespace=source.id(s), - description= - "Display current queue content.", - usage="queue", - "queue", - show_queue - ) + s.register_command( + description= + "Push a new request in the queue.", + usage= + "push ", + "push", + push + ) - def skip(_) = - s.skip() - "Done." - end - - server.register( - namespace=source.id(s), - description= - "Skip current song.", - usage="skip", - "skip", - skip - ) - } + def show_queue(_) = + queue = s.queue() + string.concat( + separator= + " ", + list.map(fun (r) -> string(request.id(r)), queue) ) + end + + s.register_command( + description= + "Display current queue content.", + usage="queue", + "queue", + show_queue + ) + + def skip(_) = + s.skip() + "Done." + end + + s.register_command( + description= + "Skip current song.", + usage="skip", + "skip", + skip ) end From ccbd0efb7128c04a96c950ab8cff7ad29b4294ce Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 9 Nov 2024 16:51:19 -0600 Subject: [PATCH 088/151] Factor out source.dump/source.drop (#4207) --- src/core/builtins/builtins_source.ml | 163 ++++++++++----------------- tests/core/dune.inc | 14 +++ tests/core/flush_test.ml | 29 +++++ 3 files changed, 103 insertions(+), 103 deletions(-) create mode 100644 tests/core/flush_test.ml diff --git a/src/core/builtins/builtins_source.ml b/src/core/builtins/builtins_source.ml index 675d50aa56..fe367166f1 100644 --- a/src/core/builtins/builtins_source.ml +++ b/src/core/builtins/builtins_source.ml @@ -162,6 +162,57 @@ let _ = s#on_sleep wrap_f; Lang.unit) +let flush_source ~log ~name ~ratio ~timeout ~sleep_latency s = + let module Time = (val Clock.time_implementation () : Liq_time.T) in + let open Time in + let started = ref false in + let stopped = ref false in + let clock = + Clock.create ~id:name ~sync:`Passive + ~on_error:(fun exn bt -> + stopped := true; + Utils.log_exception ~log + ~bt:(Printexc.raw_backtrace_to_string bt) + (Printf.sprintf "Error while processing source: %s" + (Printexc.to_string exn))) + () + in + let _ = + new Output.dummy + ~clock ~infallible:false + ~on_start:(fun () -> ()) + ~on_stop:(fun () -> stopped := true) + ~register_telnet:false ~autostart:true (Lang.source s) + in + Clock.start ~force:true clock; + log#info "Start source streaming loop (ratio: %.02fx)" ratio; + let start_time = Time.time () in + let timeout = Time.of_float timeout in + let timeout_time = Time.(start_time |+| timeout) in + let sleep_latency = Time.of_float sleep_latency in + let target_time () = + Time.(start_time |+| sleep_latency |+| of_float (Clock.time clock /. ratio)) + in + (try + while (not (Atomic.get should_stop)) && not !stopped do + if not !started then started := s#is_ready; + if (not !started) && Time.(timeout_time |<=| start_time) then ( + log#important "Timeout while waiting for the source to start!"; + stopped := true) + else ( + Clock.tick clock; + let target_time = target_time () in + if Time.(time () |<| (target_time |+| sleep_latency)) then + sleep_until target_time) + done + with Clock.Has_stopped -> ()); + let processing_time = Time.(to_float (time () |-| start_time)) in + let effective_ratio = Clock.time clock /. processing_time in + log#info + "Source processed. Total processing time: %.02fs, effective ratio: %.02fx" + processing_time effective_ratio; + Clock.stop clock + let _ = let log = Log.make ["source"; "dump"] in let kind = Lang.univ_t () in @@ -193,64 +244,19 @@ let _ = ] Lang.unit_t (fun p -> - let module Time = (val Clock.time_implementation () : Liq_time.T) in - let open Time in - let started = ref false in - let stopped = ref false in let proto = let p = Pipe_output.file_proto (Lang.univ_t ()) in - List.filter_map - (fun (l, _, v, _) -> - if l <> "on_stop" then Option.map (fun v -> (l, v)) v - else - Some - ( "on_stop", - Lang.val_fun [] (fun _ -> - stopped := true; - Lang.unit) )) - p + List.filter_map (fun (l, _, v, _) -> Option.map (fun v -> (l, v)) v) p in let proto = ("fallible", Lang.bool true) :: proto in let p = (("id", Lang.string "source.drop") :: p) @ proto in - let clock = - Clock.create ~id:"source.dump" ~sync:`Passive - ~on_error:(fun exn bt -> - stopped := true; - Utils.log_exception ~log - ~bt:(Printexc.raw_backtrace_to_string bt) - (Printf.sprintf "Error while dropping source: %s" - (Printexc.to_string exn))) - () - in - let s = Pipe_output.new_file_output ~clock p in + let s = Pipe_output.new_file_output p in let ratio = Lang.to_float (List.assoc "ratio" p) in - let timeout = Time.of_float (Lang.to_float (List.assoc "timeout" p)) in - let sleep_latency = - Time.of_float (Lang.to_float (List.assoc "sleep_latency" p)) - in - Clock.start ~force:true clock; - log#info "Start dumping source (ratio: %.02fx)" ratio; - let start_time = Time.time () in - let timeout_time = Time.(start_time |+| timeout) in - let target_time () = - Time.( - start_time |+| sleep_latency |+| of_float (Clock.time clock /. ratio)) - in - (try - while (not (Atomic.get should_stop)) && not !stopped do - if not !started then started := s#is_ready; - if (not !started) && Time.(timeout_time |<=| start_time) then ( - log#important "Timeout while waiting for the source to start!"; - stopped := true) - else ( - Clock.tick clock; - let target_time = target_time () in - if Time.(time () |<| (target_time |+| sleep_latency)) then - sleep_until target_time) - done - with Clock.Has_stopped -> ()); + let timeout = Lang.to_float (List.assoc "timeout" p) in + let sleep_latency = Lang.to_float (List.assoc "sleep_latency" p) in + flush_source ~log ~name:"source.dump" ~ratio ~timeout ~sleep_latency + (s :> Source.source); log#info "Source dumped."; - Clock.stop clock; Lang.unit) let _ = @@ -281,58 +287,9 @@ let _ = ] Lang.unit_t (fun p -> - let module Time = (val Clock.time_implementation () : Liq_time.T) in - let open Time in let s = List.assoc "" p |> Lang.to_source in - let started = ref false in - let stopped = ref false in - let clock = - Clock.create ~id:"source.dump" ~sync:`Passive - ~on_error:(fun exn bt -> - stopped := true; - Utils.log_exception ~log - ~bt:(Printexc.raw_backtrace_to_string bt) - (Printf.sprintf "Error while dropping source: %s" - (Printexc.to_string exn))) - () - in - let _ = - new Output.dummy - ~clock ~infallible:false - ~on_start:(fun () -> ()) - ~on_stop:(fun () -> stopped := true) - ~register_telnet:false ~autostart:true (Lang.source s) - in let ratio = Lang.to_float (List.assoc "ratio" p) in - let timeout = Time.of_float (Lang.to_float (List.assoc "timeout" p)) in - let sleep_latency = - Time.of_float (Lang.to_float (List.assoc "sleep_latency" p)) - in - Clock.start ~force:true clock; - log#info "Start dropping source (ratio: %.02fx)" ratio; - let start_time = Time.time () in - let timeout_time = Time.(start_time |+| timeout) in - let target_time () = - Time.(start_time |+| of_float (Clock.time clock /. ratio)) - in - (try - while (not (Atomic.get should_stop)) && not !stopped do - let start_time = Time.time () in - if not !started then started := s#is_ready; - if (not !started) && Time.(timeout_time |<=| start_time) then ( - log#important "Timeout while waiting for the source to start!"; - stopped := true) - else ( - Clock.tick clock; - let target_time = target_time () in - if Time.(time () |<| (target_time |+| sleep_latency)) then - sleep_until target_time) - done - with Clock.Has_stopped -> ()); - let processing_time = Time.(to_float (time () |-| start_time)) in - let effective_ratio = Clock.time clock /. processing_time in - log#info - "Source dropped. Total processing time: %.02fs, effective ratio: %.02fx" - processing_time effective_ratio; - Clock.stop clock; + let timeout = Lang.to_float (List.assoc "timeout" p) in + let sleep_latency = Lang.to_float (List.assoc "sleep_latency" p) in + flush_source ~log ~name:"source.dump" ~ratio ~timeout ~sleep_latency s; Lang.unit) diff --git a/tests/core/dune.inc b/tests/core/dune.inc index 07893e27a4..2a45450f8b 100644 --- a/tests/core/dune.inc +++ b/tests/core/dune.inc @@ -41,6 +41,20 @@ (action (run %{ffmpeg_quality} ))) +(executable + (name flush_test) + (modules flush_test) + (libraries liquidsoap_core liquidsoap_optionals)) + +(rule + (alias citest) + (package liquidsoap) + (deps + + (:flush_test flush_test.exe)) + (action (run %{flush_test} ))) + + (executable (name frame_test) (modules frame_test) diff --git a/tests/core/flush_test.ml b/tests/core/flush_test.ml new file mode 100644 index 0000000000..80914e42c4 --- /dev/null +++ b/tests/core/flush_test.ml @@ -0,0 +1,29 @@ +(* This can be used to manually benchmark memory usage. Otherwise, it simply exists. *) + +let () = exit 0 + +let _ = + Stdlib.Lazy.force Builtins_settings.settings_module; + Lang.eval ~cache:true ~typecheck:false ~stdlib:`Disabled + {| +%include "../../src/libs/stdlib.liq" +enable_autocue_metadata() +|} + +let () = + Frame_settings.lazy_config_eval := true; + Dtools.Log.conf_level#set 4; + Dtools.Log.conf_stdout#set true; + Dtools.Log.conf_file#set false; + Dtools.Init.exec Dtools.Log.start; + Tutils.start (); + for _ = 0 to 10 do + let r = + Request.create ~cue_in_metadata:None ~cue_out_metadata:None "/tmp/bla.mp3" + in + ignore (Request.resolve r); + Request.destroy r; + Gc.compact () + done; + Dtools.Init.exec Dtools.Log.stop; + Tutils.shutdown 0 From 62f2a1cb4e6ece2365e9635cfbe9de1bbfd28e54 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 9 Nov 2024 17:07:03 -0600 Subject: [PATCH 089/151] Force sleep. --- src/core/source.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/source.ml b/src/core/source.ml index 3355c6ab4b..f3410eb5cf 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -69,7 +69,7 @@ let source_log = Log.make ["source"] let finalise s = source_log#debug "Source %s is collected." s#id; - try s#sleep + try s#force_sleep with e -> let bt = Printexc.get_backtrace () in Utils.log_exception ~log:source_log ~bt From 3a2dbb484c61ec1d0708b90b07b064417c124bcc Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 10 Nov 2024 14:26:33 -0600 Subject: [PATCH 090/151] Make it possible to disable command registration in playlist, switch request.queue to non-interactive by default. --- src/libs/playlist.liq | 168 ++++++++++++++++++++++-------------------- src/libs/request.liq | 2 +- 2 files changed, 88 insertions(+), 82 deletions(-) diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq index d0e51e418f..1885731c72 100644 --- a/src/libs/playlist.liq +++ b/src/libs/playlist.liq @@ -463,6 +463,7 @@ end # @param ~reload_mode Unit of the reload parameter, either "never" (never reload \ # the playlist), "rounds", "seconds" or "watch" (reload the file whenever it is \ # changed). +# @param ~register_server_commands Register corresponding server commands # @param ~timeout Timeout (in sec.) to resolve the request. Defaults to `settings.request.timeout` when `null`. # @param ~thread_queue Queue used to resolve requests. # @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. @@ -490,6 +491,7 @@ def replaces playlist( ~timeout=null(), ~cue_in_metadata=null("liq_cue_in"), ~cue_out_metadata=null("liq_cue_out"), + ~register_server_commands=true, uri ) = id = id ?? playlist.id(default="playlist", uri) @@ -675,97 +677,101 @@ def replaces playlist( s.on_shutdown(watcher_shutdown) end - # Set up telnet commands - s.register_command( - description= - "Skip current song in the playlist.", - usage="skip", - "skip", - fun (_) -> - begin - s.skip() - "OK" - end - ) + if + register_server_commands + then + # Set up telnet commands + s.register_command( + description= + "Skip current song in the playlist.", + usage="skip", + "skip", + fun (_) -> + begin + s.skip() + "OK" + end + ) - s.register_command( - description= - "Return up to 10 next URIs to be played.", - usage="next", - "next", - fun (n) -> - begin - n = max(10, int_of_string(default=10, n)) - requests = - list.fold( - (fun (cur, el) -> list.length(cur) < n ? [...cur, el] : cur ), - [], - s.queue() - ) + s.register_command( + description= + "Return up to 10 next URIs to be played.", + usage="next", + "next", + fun (n) -> + begin + n = max(10, int_of_string(default=10, n)) + requests = + list.fold( + (fun (cur, el) -> list.length(cur) < n ? [...cur, el] : cur ), + [], + s.queue() + ) - string.concat( - separator="\n", - list.map( - ( - fun (r) -> - begin - m = request.metadata(r) - get = fun (lbl) -> list.assoc(default="?", lbl, m) - status = get("status") - uri = get("initial_uri") - "[#{status}] #{uri}" - end - ), - requests + string.concat( + separator="\n", + list.map( + ( + fun (r) -> + begin + m = request.metadata(r) + get = fun (lbl) -> list.assoc(default="?", lbl, m) + status = get("status") + uri = get("initial_uri") + "[#{status}] #{uri}" + end + ), + requests + ) ) - ) - end - ) + end + ) - s.register_command( - description= - "Reload the playlist, unless already being loaded.", - usage="reload", - "reload", - fun (_) -> - begin - s.reload() - "OK" - end - ) + s.register_command( + description= + "Reload the playlist, unless already being loaded.", + usage="reload", + "reload", + fun (_) -> + begin + s.reload() + "OK" + end + ) - def uri_cmd(uri') = - if - uri' == "" - then - playlist_uri() - else + def uri_cmd(uri') = if - reload_mode == "watch" + uri' == "" then - log.important( - label=id, - "Warning: the watched file is not updated for now when changing the \ - uri!" - ) - end + playlist_uri() + else + if + reload_mode == "watch" + then + log.important( + label=id, + "Warning: the watched file is not updated for now when changing the \ + uri!" + ) + end - # TODO - playlist_uri := uri' - s.reload(uri=uri') - "OK" + # TODO + playlist_uri := uri' + s.reload(uri=uri') + "OK" + end end - end - s.register_command( - description= - "Print playlist URI if called without an argument, otherwise set a new one \ - and load it.", - usage= - "uri []", - "uri", - uri_cmd - ) + s.register_command( + description= + "Print playlist URI if called without an argument, otherwise set a new \ + one and load it.", + usage= + "uri []", + "uri", + uri_cmd + ) + end s end diff --git a/src/libs/request.liq b/src/libs/request.liq index ad1691b9a4..c2dc9ade09 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -34,7 +34,7 @@ end # @method length Length of the queue. def request.queue( ~id=null(), - ~interactive=true, + ~interactive=false, ~prefetch=null(), ~native=false, ~queue=[], From fb28dac38ce9cbfb91d283313bdfdf696f10e28d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 11 Nov 2024 08:53:03 -0600 Subject: [PATCH 091/151] Don't run flush_source if scheduler is not started. --- src/core/builtins/builtins_source.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/core/builtins/builtins_source.ml b/src/core/builtins/builtins_source.ml index fe367166f1..b1f7db39c0 100644 --- a/src/core/builtins/builtins_source.ml +++ b/src/core/builtins/builtins_source.ml @@ -180,7 +180,7 @@ let flush_source ~log ~name ~ratio ~timeout ~sleep_latency s = let _ = new Output.dummy ~clock ~infallible:false - ~on_start:(fun () -> ()) + ~on_start:(fun () -> started := true) ~on_stop:(fun () -> stopped := true) ~register_telnet:false ~autostart:true (Lang.source s) in @@ -195,7 +195,6 @@ let flush_source ~log ~name ~ratio ~timeout ~sleep_latency s = in (try while (not (Atomic.get should_stop)) && not !stopped do - if not !started then started := s#is_ready; if (not !started) && Time.(timeout_time |<=| start_time) then ( log#important "Timeout while waiting for the source to start!"; stopped := true) @@ -213,6 +212,11 @@ let flush_source ~log ~name ~ratio ~timeout ~sleep_latency s = processing_time effective_ratio; Clock.stop clock +let flush_source ~log ~name ~ratio ~timeout ~sleep_latency s = + if Tutils.running () then + flush_source ~log ~name ~ratio ~timeout ~sleep_latency s + else log#important "Cannot run %s: scheduler not started!" name + let _ = let log = Log.make ["source"; "dump"] in let kind = Lang.univ_t () in From ac4266e972fac079ba08539fc4481a2874edc423 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 11 Nov 2024 12:30:56 -0600 Subject: [PATCH 092/151] Make set_thread_name future proof. --- src/core/tools/tutils.ml | 2 +- src/core/tools/unix_c.c | 2 +- src/core/tools/utils.ml | 7 ++++++- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/core/tools/tutils.ml b/src/core/tools/tutils.ml index cef2b88e49..962b3c9ead 100644 --- a/src/core/tools/tutils.ml +++ b/src/core/tools/tutils.ml @@ -156,7 +156,7 @@ let create ~queue f x s = (fun () -> let id = let process x = - Utils.set_thread_name s; + Utils.Thread.set_current_thread_name s; try f x; Mutex_utils.mutexify lock diff --git a/src/core/tools/unix_c.c b/src/core/tools/unix_c.c index e3710b2f20..46fe7e0a5c 100644 --- a/src/core/tools/unix_c.c +++ b/src/core/tools/unix_c.c @@ -94,7 +94,7 @@ CAMLprim value liquidsoap_get_pagesize() { #endif } -CAMLprim value liquidsoap_set_thread_name(value _name) { +CAMLprim value liquidsoap_set_current_thread_name(value _name) { #if defined(_WIN32) char_os *thread_name = caml_stat_strdup_to_os(String_val(_name)); SetThreadDescription(GetCurrentThread(), thread_name); diff --git a/src/core/tools/utils.ml b/src/core/tools/utils.ml index 16074d5b9a..47baa170e0 100644 --- a/src/core/tools/utils.ml +++ b/src/core/tools/utils.ml @@ -32,7 +32,12 @@ let log_exception ~(log : Log.t) ~bt msg = log#severe "%s" msg; if log#active 4 (* info *) then log#info "%s" bt -external set_thread_name : string -> unit = "liquidsoap_set_thread_name" +module Thread = struct + external set_current_thread_name : string -> unit + = "liquidsoap_set_current_thread_name" + + include Thread +end (* Force locale *) external force_locale : string -> unit = "liquidsoap_set_locale" From 3bd220fe8b7a4eeb3b0507f32aaae0bcfed0b28e Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 11 Nov 2024 12:33:30 -0600 Subject: [PATCH 093/151] Get rid of stdlib wrapper. --- src/core/builtins/builtins_files.ml | 10 ++++--- src/core/builtins/builtins_server.ml | 2 +- src/core/builtins/builtins_sqlite.ml | 4 +-- src/core/builtins/builtins_sys.ml | 3 +- src/core/dune | 1 - src/core/encoder/formats/ffmpeg_format.ml | 4 +-- src/core/encoder/lang/lang_ffmpeg.ml | 4 +-- src/core/harbor/harbor.ml | 25 ++++++++-------- src/core/io/ffmpeg_io.ml | 11 ++++--- src/core/io/srt_io.ml | 5 +++- src/core/operators/chord.ml | 9 +++--- src/core/operators/frei0r_op.ml | 10 +++++-- src/core/operators/ladspa_op.ml | 2 +- src/core/outputs/pipe_output.ml | 2 +- src/core/playlists/playlist_basic.ml | 32 ++++++++++---------- src/core/request.ml | 4 +-- src/core/source.ml | 5 +++- src/core/sources/harbor_input.ml | 4 +-- src/core/stream/ffmpeg_raw_content.ml | 8 ++--- src/core/synth/dssi_op.ml | 4 +-- src/core/tools/liq_http.ml | 28 +++++++++--------- src/core/tools/liqcurl.ml | 10 ++++--- src/core/tools/sandbox.ml | 2 +- src/core/tools/server.ml | 4 ++- src/core/tools/tutils.ml | 2 +- src/core/tools/utils.ml | 36 +++++++++++++++-------- src/runtime/dune | 1 - src/runtime/main.ml | 2 +- src/stdlib/dune | 12 -------- src/stdlib/hashtbl.ml | 1 - src/stdlib/hashtbl.mli | 17 ----------- src/stdlib/pcre.ml | 1 - src/stdlib/pcre.mli | 1 - 33 files changed, 134 insertions(+), 132 deletions(-) delete mode 100644 src/stdlib/dune delete mode 100644 src/stdlib/hashtbl.ml delete mode 100644 src/stdlib/hashtbl.mli delete mode 100644 src/stdlib/pcre.ml delete mode 100644 src/stdlib/pcre.mli diff --git a/src/core/builtins/builtins_files.ml b/src/core/builtins/builtins_files.ml index 8035f199ad..0466f3247a 100644 --- a/src/core/builtins/builtins_files.ml +++ b/src/core/builtins/builtins_files.ml @@ -264,21 +264,23 @@ let _ = let pattern = pattern |> Option.map (fun s -> - Pcre.substitute ~rex:(Pcre.regexp "\\.") + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\.") ~subst:(fun _ -> "\\.") s) |> Option.map (fun s -> - Pcre.substitute ~rex:(Pcre.regexp "\\*") ~subst:(fun _ -> ".*") s) + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\*") + ~subst:(fun _ -> ".*") + s) |> Option.map (fun s -> "^" ^ s ^ "$") |> Option.value ~default:"" in let sorted = List.assoc "sorted" p |> Lang.to_bool in - let rex = Pcre.regexp pattern in + let rex = Re.Pcre.regexp pattern in let dir = Lang.to_string (List.assoc "" p) in let dir = Lang_string.home_unrelate dir in let readdir dir = Array.to_list (Sys.readdir dir) - |> List.filter (fun s -> Pcre.pmatch ~rex s) + |> List.filter (fun s -> Re.Pcre.pmatch ~rex s) in let files = if not recursive then readdir dir diff --git a/src/core/builtins/builtins_server.ml b/src/core/builtins/builtins_server.ml index 3ac73c2336..32524f8928 100644 --- a/src/core/builtins/builtins_server.ml +++ b/src/core/builtins/builtins_server.ml @@ -64,6 +64,6 @@ let _ = in let f = Lang.assoc "" 2 p in let f x = Lang.to_string (Lang.apply f [("", Lang.string x)]) in - let ns = Pcre.split ~rex:(Pcre.regexp "\\.") namespace in + let ns = Re.Pcre.split ~rex:(Re.Pcre.regexp "\\.") namespace in Server.add ~ns ~usage ~descr command f; Lang.unit) diff --git a/src/core/builtins/builtins_sqlite.ml b/src/core/builtins/builtins_sqlite.ml index 82fb6f9aa7..0a659247e4 100644 --- a/src/core/builtins/builtins_sqlite.ml +++ b/src/core/builtins/builtins_sqlite.ml @@ -26,8 +26,8 @@ let error fmt = fmt let escape = - let rex = Pcre.regexp "'" in - fun s -> "'" ^ Pcre.substitute ~rex ~subst:(fun _ -> "''") s ^ "'" + let rex = Re.Pcre.regexp "'" in + fun s -> "'" ^ Re.Pcre.substitute ~rex ~subst:(fun _ -> "''") s ^ "'" let insert_value_constr = let open Type in diff --git a/src/core/builtins/builtins_sys.ml b/src/core/builtins/builtins_sys.ml index 54238b0b9b..dbf5f16b78 100644 --- a/src/core/builtins/builtins_sys.ml +++ b/src/core/builtins/builtins_sys.ml @@ -216,7 +216,8 @@ let _ = let a = Lang.to_string (Lang.assoc "" 2 p) in let s = match a with "" -> c | _ -> c ^ " " ^ a in let r = try Server.exec s with Not_found -> "Command not found!" in - Lang.list (List.map Lang.string (Pcre.split ~rex:(Pcre.regexp "\r?\n") r)) + Lang.list + (List.map Lang.string (Re.Pcre.split ~rex:(Re.Pcre.regexp "\r?\n") r)) in Lang.add_builtin ~base:Modules.server "execute" ~category ~descr params return_t execute diff --git a/src/core/dune b/src/core/dune index 5a5c2c5a1d..6933405e89 100644 --- a/src/core/dune +++ b/src/core/dune @@ -25,7 +25,6 @@ fileutils liquidsoap-lang liquidsoap-lang.console - liquidsoap_stdlib menhirLib camomile.lib curl diff --git a/src/core/encoder/formats/ffmpeg_format.ml b/src/core/encoder/formats/ffmpeg_format.ml index 2066ab5ad5..8aabed7639 100644 --- a/src/core/encoder/formats/ffmpeg_format.ml +++ b/src/core/encoder/formats/ffmpeg_format.ml @@ -137,7 +137,7 @@ let to_string m = | None -> `Var "none" | Some d -> `String d); Printf.sprintf "%%%s(%s%s)" name - (if Pcre.pmatch ~rex:(Pcre.regexp "video") name then "" + (if Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "video") name then "" else "video_content,") (string_of_options stream_opts) :: opts @@ -152,7 +152,7 @@ let to_string m = Hashtbl.replace stream_opts "samplerate" (`Int (Lazy.force options.samplerate)); Printf.sprintf "%s(%s%s)" name - (if Pcre.pmatch ~rex:(Pcre.regexp "audio") name then "" + (if Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "audio") name then "" else "audio_content,") (string_of_options stream_opts) :: opts) diff --git a/src/core/encoder/lang/lang_ffmpeg.ml b/src/core/encoder/lang/lang_ffmpeg.ml index 9fa1e28033..39d00b5563 100644 --- a/src/core/encoder/lang/lang_ffmpeg.ml +++ b/src/core/encoder/lang/lang_ffmpeg.ml @@ -117,8 +117,8 @@ let stream_media_type ~to_pos ~to_static_string name args = match (name, args) with | _ when has_content ~to_static_string "audio_content" args -> `Audio | _ when has_content ~to_static_string "video_content" args -> `Video - | _ when Pcre.pmatch ~rex:(Pcre.regexp "audio") name -> `Audio - | _ when Pcre.pmatch ~rex:(Pcre.regexp "video") name -> `Video + | _ when Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "audio") name -> `Audio + | _ when Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "video") name -> `Video | _ -> ( match List.assoc_opt "codec" args with | Some t -> ( diff --git a/src/core/harbor/harbor.ml b/src/core/harbor/harbor.ml index 3c62adde0e..aed4436454 100644 --- a/src/core/harbor/harbor.ml +++ b/src/core/harbor/harbor.ml @@ -361,7 +361,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let websocket_error n msg = Websocket.to_string (`Close (Some (n, msg))) let parse_icy_request_line ~port h r = - let auth_data = Pcre.split ~rex:(Pcre.regexp ":") r in + let auth_data = Re.Pcre.split ~rex:(Re.Pcre.regexp ":") r in let requested_user, password = match auth_data with | user :: password :: _ -> (user, password) @@ -387,7 +387,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let parse_http_request_line r = try - let data = Pcre.split ~rex:(Pcre.regexp "[ \t]+") r in + let data = Re.Pcre.split ~rex:(Re.Pcre.regexp "[ \t]+") r in let protocol = verb_or_source_of_string (List.nth data 0) in Duppy.Monad.return ( protocol, @@ -409,9 +409,9 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let parse_headers headers = let split_header h l = try - let rex = Pcre.regexp "([^:\\r\\n]+):\\s*([^\\r\\n]+)" in - let sub = Pcre.exec ~rex h in - (Pcre.get_substring sub 1, Pcre.get_substring sub 2) :: l + let rex = Re.Pcre.regexp "([^:\\r\\n]+):\\s*([^\\r\\n]+)" in + let sub = Re.Pcre.exec ~rex h in + (Re.Pcre.get_substring sub 1, Re.Pcre.get_substring sub 2) :: l with Not_found -> l in let f x = String.uppercase_ascii x in @@ -449,11 +449,12 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct try (* HTTP authentication *) let auth = assoc_uppercase "AUTHORIZATION" headers in - let data = Pcre.split ~rex:(Pcre.regexp "[ \t]+") auth in + let data = Re.Pcre.split ~rex:(Re.Pcre.regexp "[ \t]+") auth in match data with | "Basic" :: x :: _ -> ( let auth_data = - Pcre.split ~rex:(Pcre.regexp ":") (Lang_string.decode64 x) + Re.Pcre.split ~rex:(Re.Pcre.regexp ":") + (Lang_string.decode64 x) in match auth_data with | x :: y :: _ -> (x, y) @@ -767,11 +768,11 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct | _ -> ans_500 uri let handle_http_request ~hmethod ~hprotocol ~port h uri headers = - let rex = Pcre.regexp "^(.+)\\?(.+)$" in + let rex = Re.Pcre.regexp "^(.+)\\?(.+)$" in let base_uri, args = try - let sub = Pcre.exec ~rex uri in - (Pcre.get_substring sub 1, Pcre.get_substring sub 2) + let sub = Re.Pcre.exec ~rex uri in + (Re.Pcre.get_substring sub 1, Re.Pcre.get_substring sub 2) with Not_found -> (uri, "") in let smethod = string_of_verb hmethod in @@ -920,7 +921,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct | false -> Duppy.Io.Split "[\r]?\n[\r]?\n") h in - let lines = Pcre.split ~rex:(Pcre.regexp "[\r]?\n") s in + let lines = Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r]?\n") s in let* hmethod, huri, hprotocol = let s = List.hd lines in if icy then parse_icy_request_line ~port h s @@ -1002,7 +1003,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct ~priority:`Non_blocking ~marker:(Duppy.Io.Split "[\r]?\n[\r]?\n") h in - let lines = Pcre.split ~rex:(Pcre.regexp "[\r]?\n") s in + let lines = Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r]?\n") s in let headers = parse_headers lines in handle_source_request ~port ~auth:true ~smethod:`Shout hprotocol h huri headers diff --git a/src/core/io/ffmpeg_io.ml b/src/core/io/ffmpeg_io.ml index 052690de3b..189821de85 100644 --- a/src/core/io/ffmpeg_io.ml +++ b/src/core/io/ffmpeg_io.ml @@ -294,15 +294,18 @@ class http_input ~autostart ~self_sync ~poll_delay ~debug ~on_error ~max_buffer Avutil.Options.get_string ~search_children:true ~name:"icy_metadata_headers" (Av.input_obj input) in - let icy_headers = Pcre.split ~rex:(Pcre.regexp "[\r]?\n") icy_headers in + let icy_headers = + Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r]?\n") icy_headers + in List.fold_left (fun ret header -> if header <> "" then ( try let res = - Pcre.exec ~rex:(Pcre.regexp "([^:]*):\\s*(.*)") header + Re.Pcre.exec ~rex:(Re.Pcre.regexp "([^:]*):\\s*(.*)") header in - (Pcre.get_substring res 1, Pcre.get_substring res 2) :: ret + (Re.Pcre.get_substring res 1, Re.Pcre.get_substring res 2) + :: ret with Not_found -> ret) else ret) [] icy_headers @@ -556,7 +559,7 @@ let register_input is_http = (Lang.apply fn [("", Lang.metadata_list m)]) | None -> List.filter (fun (k, _) -> - not (Pcre.pmatch ~rex:(Pcre.regexp "^id3v2_priv") k)) + not (Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "^id3v2_priv") k)) in let deduplicate_metadata = Lang.to_bool (List.assoc "deduplicate_metadata" p) diff --git a/src/core/io/srt_io.ml b/src/core/io/srt_io.ml index f870441e6d..0d0ad63855 100644 --- a/src/core/io/srt_io.ml +++ b/src/core/io/srt_io.ml @@ -300,7 +300,10 @@ let log = Log.make ["srt"] let log_handler { Srt.Log.message } = let message = - Pcre.substitute ~rex:(Pcre.regexp "[ \r\n]+$") ~subst:(fun _ -> "") message + Re.Pcre.substitute + ~rex:(Re.Pcre.regexp "[ \r\n]+$") + ~subst:(fun _ -> "") + message in log#f conf_level#get "%s" message diff --git a/src/core/operators/chord.ml b/src/core/operators/chord.ml index 741742fd4f..aa6561411a 100644 --- a/src/core/operators/chord.ml +++ b/src/core/operators/chord.ml @@ -67,13 +67,14 @@ class chord metadata_name (source : source) = | Some c -> ( try let sub = - Pcre.exec - ~rex:(Pcre.regexp "^([A-G-](?:b|#)?)(|M|m|M7|m7|dim)$") + Re.Pcre.exec + ~rex: + (Re.Pcre.regexp "^([A-G-](?:b|#)?)(|M|m|M7|m7|dim)$") c in - let n = Pcre.get_substring sub 1 in + let n = Re.Pcre.get_substring sub 1 in let n = note_of_string n in - let m = Pcre.get_substring sub 2 in + let m = Re.Pcre.get_substring sub 2 in ans := (t, n, m) :: !ans with Not_found -> self#log#important "Could not parse chord '%s'." c)) diff --git a/src/core/operators/frei0r_op.ml b/src/core/operators/frei0r_op.ml index 8c06e0c5f0..0ace2135a6 100644 --- a/src/core/operators/frei0r_op.ml +++ b/src/core/operators/frei0r_op.ml @@ -39,7 +39,7 @@ let frei0r_enable = let plugin_dirs = try let path = Unix.getenv "LIQ_FREI0R_PATH" in - Pcre.split ~rex:(Pcre.regexp ":") path + Re.Pcre.split ~rex:(Re.Pcre.regexp ":") path with Not_found -> Frei0r.default_paths class frei0r_filter ~name bgra instance params (source : source) = @@ -317,7 +317,9 @@ let register_plugin fname = let explanation = let e = info.Frei0r.explanation in let e = String.capitalize_ascii e in - let e = Pcre.substitute ~rex:(Pcre.regexp "@") ~subst:(fun _ -> "(at)") e in + let e = + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "@") ~subst:(fun _ -> "(at)") e + in if e = "" then e else if e.[String.length e - 1] = '.' then String.sub e 0 (String.length e - 1) @@ -325,7 +327,9 @@ let register_plugin fname = in let author = let a = info.Frei0r.author in - let a = Pcre.substitute ~rex:(Pcre.regexp "@") ~subst:(fun _ -> "(at)") a in + let a = + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "@") ~subst:(fun _ -> "(at)") a + in a in let descr = Printf.sprintf "%s (by %s)." explanation author in diff --git a/src/core/operators/ladspa_op.ml b/src/core/operators/ladspa_op.ml index a492106db5..82b3a79c2f 100644 --- a/src/core/operators/ladspa_op.ml +++ b/src/core/operators/ladspa_op.ml @@ -366,7 +366,7 @@ let register_descr d = in let maker = d.plugin_maker in let maker = - Pcre.substitute ~rex:(Pcre.regexp "@") ~subst:(fun _ -> "(at)") maker + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "@") ~subst:(fun _ -> "(at)") maker in let descr = Printf.sprintf "%s by %s." d.plugin_name maker in let return_t = diff --git a/src/core/outputs/pipe_output.ml b/src/core/outputs/pipe_output.ml index 6f97fbfa20..e3873f03ba 100644 --- a/src/core/outputs/pipe_output.ml +++ b/src/core/outputs/pipe_output.ml @@ -446,7 +446,7 @@ class virtual ['a] file_output_base p = let filename = Lang_string.home_unrelate filename in (* Avoid / in metas for filename.. *) let subst m = - Pcre.substitute ~rex:(Pcre.regexp "/") ~subst:(fun _ -> "-") m + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "/") ~subst:(fun _ -> "-") m in self#interpolate ~subst filename diff --git a/src/core/playlists/playlist_basic.ml b/src/core/playlists/playlist_basic.ml index 68e15bebf8..8a14dc44b9 100644 --- a/src/core/playlists/playlist_basic.ml +++ b/src/core/playlists/playlist_basic.ml @@ -21,7 +21,7 @@ *****************************************************************************) let log = Log.make ["playlist"; "basic"] -let split_lines buf = Pcre.split ~rex:(Pcre.regexp "[\r\n]+") buf +let split_lines buf = Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r\n]+") buf let parse_meta = let processor = @@ -48,20 +48,20 @@ let parse_meta = let parse_extinf s = try - let rex = Pcre.regexp "#EXTINF:(\\d*)\\s*(.*)" in - let sub = Pcre.exec ~rex s in + let rex = Re.Pcre.regexp "#EXTINF:(\\d*)\\s*(.*)" in + let sub = Re.Pcre.exec ~rex s in let meta, song = - match Pcre.get_substring sub 2 with + match Re.Pcre.get_substring sub 2 with | "" -> ([], "") | s when s.[0] = ',' -> ([], String.sub s 1 (String.length s - 1)) | s -> parse_meta s in let meta = - match Pcre.get_substring sub 1 with + match Re.Pcre.get_substring sub 1 with | "" -> meta | duration -> ("extinf_duration", duration) :: meta in - let lines = Pcre.split ~rex:(Pcre.regexp "\\s*-\\s*") song in + let lines = Re.Pcre.split ~rex:(Re.Pcre.regexp "\\s*-\\s*") song in meta @ match lines with @@ -75,7 +75,7 @@ let parse_extinf s = (* This parser cannot detect the format !! *) let parse_mpegurl ?pwd string = let lines = List.filter (fun x -> x <> "") (split_lines string) in - let is_info line = Pcre.pmatch ~rex:(Pcre.regexp "^#EXTINF") line in + let is_info line = Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "^#EXTINF") line in let skip_line line = line.[0] == '#' in let rec get_urls cur lines = match lines with @@ -91,15 +91,15 @@ let parse_mpegurl ?pwd string = let parse_scpls ?pwd string = let string = - Pcre.substitute - ~rex:(Pcre.regexp "#[^\\r\\n]*[\\n\\r]+") + Re.Pcre.substitute + ~rex:(Re.Pcre.regexp "#[^\\r\\n]*[\\n\\r]+") ~subst:(fun _ -> "") string in (* Format check, raise Not_found if invalid *) ignore - (Pcre.exec - ~rex:(Pcre.regexp "^[\\r\\n\\s]*\\[playlist\\]") + (Re.Pcre.exec + ~rex:(Re.Pcre.regexp "^[\\r\\n\\s]*\\[playlist\\]") (String.lowercase_ascii string)); let lines = split_lines string in let urls = @@ -107,10 +107,10 @@ let parse_scpls ?pwd string = (fun s -> try let rex = - Pcre.regexp ~flags:[`CASELESS] "file\\d*\\s*=\\s*(.*)\\s*" + Re.Pcre.regexp ~flags:[`CASELESS] "file\\d*\\s*=\\s*(.*)\\s*" in - let sub = Pcre.exec ~rex s in - Pcre.get_substring sub 1 + let sub = Re.Pcre.exec ~rex s in + Re.Pcre.get_substring sub 1 with Not_found -> "") lines in @@ -233,7 +233,9 @@ let parse_cue ?pwd string = let strings = List.map (fun string -> - Pcre.substitute ~rex:(Pcre.regexp "^\\s+") ~subst:(fun _ -> "") string) + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "^\\s+") + ~subst:(fun _ -> "") + string) strings in let strings = List.filter (fun s -> s <> "") strings in diff --git a/src/core/request.ml b/src/core/request.ml index 6fc204af8a..47d0463d45 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -60,10 +60,10 @@ let pretty_date date = let remove_file_proto s = (* First remove file:// 🤮 *) let s = - Pcre.substitute ~rex:(Pcre.regexp "^file://") ~subst:(fun _ -> "") s + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "^file://") ~subst:(fun _ -> "") s in (* Then remove file: 😇 *) - Pcre.substitute ~rex:(Pcre.regexp "^file:") ~subst:(fun _ -> "") s + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "^file:") ~subst:(fun _ -> "") s let home_unrelate s = Lang_string.home_unrelate (remove_file_proto s) diff --git a/src/core/source.ml b/src/core/source.ml index f3410eb5cf..d3bd3103e0 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -115,7 +115,10 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = method set_id ?(definitive = true) s = let s = - Pcre.substitute ~rex:(Pcre.regexp "[ \t\n.]") ~subst:(fun _ -> "_") s + Re.Pcre.substitute + ~rex:(Re.Pcre.regexp "[ \t\n.]") + ~subst:(fun _ -> "_") + s in if not definitive_id then ( id <- Lang_string.generate_id s; diff --git a/src/core/sources/harbor_input.ml b/src/core/sources/harbor_input.ml index b56bd637ac..a57f924efd 100644 --- a/src/core/sources/harbor_input.ml +++ b/src/core/sources/harbor_input.ml @@ -177,8 +177,8 @@ class http_input_server ~pos ~transport ~dumpfile ~logfile ~bufferize ~max ~icy method register_decoder mime = let mime = try - let sub = Pcre.exec ~rex:(Pcre.regexp "^([^;]+);.*$") mime in - Pcre.get_substring sub 1 + let sub = Re.Pcre.exec ~rex:(Re.Pcre.regexp "^([^;]+);.*$") mime in + Re.Pcre.get_substring sub 1 with Not_found -> mime in match Decoder.get_stream_decoder ~ctype:self#content_type mime with diff --git a/src/core/stream/ffmpeg_raw_content.ml b/src/core/stream/ffmpeg_raw_content.ml index 0a2dd43954..ecf0994cc0 100644 --- a/src/core/stream/ffmpeg_raw_content.ml +++ b/src/core/stream/ffmpeg_raw_content.ml @@ -228,12 +228,12 @@ module VideoSpecs = struct | "pixel_aspect" -> let pixel_aspect = try - let rex = Pcre.regexp "(\\d+)/(\\d+)" in - let sub = Pcre.exec ~rex value in + let rex = Re.Pcre.regexp "(\\d+)/(\\d+)" in + let sub = Re.Pcre.exec ~rex value in Some { - Avutil.num = int_of_string (Pcre.get_substring sub 1); - den = int_of_string (Pcre.get_substring sub 2); + Avutil.num = int_of_string (Re.Pcre.get_substring sub 1); + den = int_of_string (Re.Pcre.get_substring sub 2); } with _ -> None in diff --git a/src/core/synth/dssi_op.ml b/src/core/synth/dssi_op.ml index 1990fe3936..72f61f00b9 100644 --- a/src/core/synth/dssi_op.ml +++ b/src/core/synth/dssi_op.ml @@ -35,13 +35,13 @@ let dssi_enable = let dssi_load = try let venv = Unix.getenv "LIQ_DSSI_LOAD" in - Pcre.split ~rex:(Pcre.regexp ":") venv + Re.Pcre.split ~rex:(Re.Pcre.regexp ":") venv with Not_found -> [] let plugin_dirs = try let path = Unix.getenv "LIQ_DSSI_PATH" in - Pcre.split ~rex:(Pcre.regexp ":") path + Re.Pcre.split ~rex:(Re.Pcre.regexp ":") path with Not_found -> ["/usr/lib/dssi"; "/usr/local/lib/dssi"] (* Number of channels to synthesize when in all mode *) diff --git a/src/core/tools/liq_http.ml b/src/core/tools/liq_http.ml index a119d2815e..d6eae3835c 100644 --- a/src/core/tools/liq_http.ml +++ b/src/core/tools/liq_http.ml @@ -95,7 +95,7 @@ let user_agent = Configure.vendor let args_split s = let args = Hashtbl.create 2 in let fill_arg arg = - match Pcre.split ~rex:(Pcre.regexp "=") arg with + match Re.Pcre.split ~rex:(Re.Pcre.regexp "=") arg with | e :: l -> (* There should be only arg=value *) List.iter @@ -105,38 +105,38 @@ let args_split s = l | [] -> () in - List.iter fill_arg (Pcre.split ~rex:(Pcre.regexp "&") s); + List.iter fill_arg (Re.Pcre.split ~rex:(Re.Pcre.regexp "&") s); args let parse_url url = let basic_rex = - Pcre.regexp "^([Hh][Tt][Tt][Pp][sS]?)://([^/:]+)(:[0-9]+)?(/.*)?$" + Re.Pcre.regexp "^([Hh][Tt][Tt][Pp][sS]?)://([^/:]+)(:[0-9]+)?(/.*)?$" in let sub = - try Pcre.exec ~rex:basic_rex url + try Re.Pcre.exec ~rex:basic_rex url with Not_found -> (* raise Invalid_url *) failwith "Invalid URL." in - let protocol = Pcre.get_substring sub 1 in - let host = Pcre.get_substring sub 2 in + let protocol = Re.Pcre.get_substring sub 1 in + let host = Re.Pcre.get_substring sub 2 in let port = try - let port = Pcre.get_substring sub 3 in + let port = Re.Pcre.get_substring sub 3 in let port = String.sub port 1 (String.length port - 1) in let port = int_of_string port in Some port with Not_found -> None in - let path = try Pcre.get_substring sub 4 with Not_found -> "/" in + let path = try Re.Pcre.get_substring sub 4 with Not_found -> "/" in { protocol; host; port; path } let is_url path = - Pcre.pmatch ~rex:(Pcre.regexp "^[Hh][Tt][Tt][Pp][sS]?://.+") path + Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "^[Hh][Tt][Tt][Pp][sS]?://.+") path let dirname url = - let rex = Pcre.regexp "^([Hh][Tt][Tt][Pp][sS]?://.+/)[^/]*$" in - let s = Pcre.exec ~rex url in - Pcre.get_substring s 1 + let rex = Re.Pcre.regexp "^([Hh][Tt][Tt][Pp][sS]?://.+/)[^/]*$" in + let s = Re.Pcre.exec ~rex url in + Re.Pcre.get_substring s 1 (* An ugly code to read until we see [\r]?\n n times. *) let read_crlf ?(log = fun _ -> ()) ?(max = 4096) ?(count = 2) ~timeout @@ -195,8 +195,8 @@ let really_read ~timeout (socket : socket) len = (* Read chunked transfer. *) let read_chunked ~timeout (socket : socket) = let read = read_crlf ~count:1 ~timeout socket in - let len = List.hd (Pcre.split ~rex:(Pcre.regexp "[\r]?\n") read) in - let len = List.hd (Pcre.split ~rex:(Pcre.regexp ";") len) in + let len = List.hd (Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r]?\n") read) in + let len = List.hd (Re.Pcre.split ~rex:(Re.Pcre.regexp ";") len) in let len = int_of_string ("0x" ^ len) in let s = really_read socket ~timeout len in ignore (read_crlf ~count:1 ~timeout socket); diff --git a/src/core/tools/liqcurl.ml b/src/core/tools/liqcurl.ml index d1847fb617..d432251bf1 100644 --- a/src/core/tools/liqcurl.ml +++ b/src/core/tools/liqcurl.ml @@ -193,7 +193,7 @@ let rec http_request ?headers ?http_version ~follow_redirect ~timeout ~url ~request ~on_body_data ~pos () | _ -> let response_headers = - Pcre.split ~rex:(Pcre.regexp "[\r]?\n") + Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r]?\n") (Buffer.contents response_headers) in let http_version, status_code, status_message = @@ -205,10 +205,12 @@ let rec http_request ?headers ?http_version ~follow_redirect ~timeout ~url if header <> "" then ( try let res = - Pcre.exec ~rex:(Pcre.regexp "([^:]*):\\s*(.*)") header + Re.Pcre.exec + ~rex:(Re.Pcre.regexp "([^:]*):\\s*(.*)") + header in - ( String.lowercase_ascii (Pcre.get_substring res 1), - Pcre.get_substring res 2 ) + ( String.lowercase_ascii (Re.Pcre.get_substring res 1), + Re.Pcre.get_substring res 2 ) :: ret with Not_found -> ret) else ret) diff --git a/src/core/tools/sandbox.ml b/src/core/tools/sandbox.ml index 3fb8e74e63..4cd30955a4 100644 --- a/src/core/tools/sandbox.ml +++ b/src/core/tools/sandbox.ml @@ -41,7 +41,7 @@ let conf_setenv = let get_setenv () = List.fold_left (fun cur s -> - match Pcre.split ~rex:(Pcre.regexp "=") s with + match Re.Pcre.split ~rex:(Re.Pcre.regexp "=") s with | [] -> cur | lbl :: l -> (lbl, String.concat "=" l) :: cur) [] conf_setenv#get diff --git a/src/core/tools/server.ml b/src/core/tools/server.ml index bcb19e0386..d35bc5474e 100644 --- a/src/core/tools/server.ml +++ b/src/core/tools/server.ml @@ -238,7 +238,9 @@ let () = ~descr:"Get information on available commands." (fun args -> try let args = - Pcre.substitute ~rex:(Pcre.regexp "\\s*") ~subst:(fun _ -> "") args + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\s*") + ~subst:(fun _ -> "") + args in let _, us, d = Mutex_utils.mutexify lock (Hashtbl.find commands) args in Printf.sprintf "Usage: %s\r\n %s" us d diff --git a/src/core/tools/tutils.ml b/src/core/tools/tutils.ml index 962b3c9ead..b7faea6678 100644 --- a/src/core/tools/tutils.ml +++ b/src/core/tools/tutils.ml @@ -191,7 +191,7 @@ let create ~queue f x s = (Printexc.to_string e); Printexc.raise_with_backtrace e raw_bt with e -> - let l = Pcre.split ~rex:(Pcre.regexp "\n") bt in + let l = Re.Pcre.split ~rex:(Re.Pcre.regexp "\n") bt in List.iter (log#info "%s") l; Mutex_utils.mutexify lock (fun () -> diff --git a/src/core/tools/utils.ml b/src/core/tools/utils.ml index 47baa170e0..b341f3b0ca 100644 --- a/src/core/tools/utils.ml +++ b/src/core/tools/utils.ml @@ -291,10 +291,10 @@ let strftime ?time str : string = ] in let subst sub = - let key = Pcre.get_substring sub 1 in + let key = Re.Pcre.get_substring sub 1 in try List.assoc key assoc with _ -> "%" ^ key in - Re.replace (Pcre.regexp "%(.)") ~f:subst str + Re.replace (Re.Pcre.regexp "%(.)") ~f:subst str (** Check if a directory exists. *) let is_dir d = @@ -327,9 +327,9 @@ let get_tempdir () = (** Get a file/uri extension. *) let get_ext s = try - let rex = Pcre.regexp "\\.([a-zA-Z0-9]+)[^.]*$" in - let ret = Pcre.exec ~rex s in - String.lowercase_ascii (Pcre.get_substring ret 1) + let rex = Re.Pcre.regexp "\\.([a-zA-Z0-9]+)[^.]*$" in + let ret = Re.Pcre.exec ~rex s in + String.lowercase_ascii (Re.Pcre.get_substring ret 1) with _ -> raise Not_found let get_ext_opt s = try Some (get_ext s) with Not_found -> None @@ -354,22 +354,34 @@ let uptime = (** Generate a string which can be used as a parameter name. *) let normalize_parameter_string s = let s = - Pcre.substitute - ~rex:(Pcre.regexp "( *\\([^\\)]*\\)| *\\[[^\\]]*\\])") + Re.Pcre.substitute + ~rex:(Re.Pcre.regexp "( *\\([^\\)]*\\)| *\\[[^\\]]*\\])") ~subst:(fun _ -> "") s in let s = - Pcre.substitute ~rex:(Pcre.regexp "(\\.+|\\++)") ~subst:(fun _ -> "") s + Re.Pcre.substitute + ~rex:(Re.Pcre.regexp "(\\.+|\\++)") + ~subst:(fun _ -> "") + s in - let s = Pcre.substitute ~rex:(Pcre.regexp " +$") ~subst:(fun _ -> "") s in let s = - Pcre.substitute ~rex:(Pcre.regexp "( +|/+|-+)") ~subst:(fun _ -> "_") s + Re.Pcre.substitute ~rex:(Re.Pcre.regexp " +$") ~subst:(fun _ -> "") s + in + let s = + Re.Pcre.substitute + ~rex:(Re.Pcre.regexp "( +|/+|-+)") + ~subst:(fun _ -> "_") + s + in + let s = + Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\"") ~subst:(fun _ -> "") s in - let s = Pcre.substitute ~rex:(Pcre.regexp "\"") ~subst:(fun _ -> "") s in let s = String.lowercase_ascii s in (* Identifiers cannot begin with a digit. *) - let s = if Pcre.pmatch ~rex:(Pcre.regexp "^[0-9]") s then "_" ^ s else s in + let s = + if Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "^[0-9]") s then "_" ^ s else s + in s (** A function to reopen a file descriptor diff --git a/src/runtime/dune b/src/runtime/dune index 9b3c8e8676..859df39273 100644 --- a/src/runtime/dune +++ b/src/runtime/dune @@ -4,7 +4,6 @@ (pps ppx_string)) (libraries liquidsoap_core - liquidsoap_stdlib liquidsoap_optionals liquidsoap_builtins (select diff --git a/src/runtime/main.ml b/src/runtime/main.ml index 3166b70dad..743b01ca16 100644 --- a/src/runtime/main.ml +++ b/src/runtime/main.ml @@ -194,7 +194,7 @@ let format_doc s = let prefix = "\t " in let indent = 8 + 2 in let max_width = 80 in - let s = Pcre.split ~rex:(Pcre.regexp " ") s in + let s = Re.Pcre.split ~rex:(Re.Pcre.regexp " ") s in let s = let rec join line width = function | [] -> [line] diff --git a/src/stdlib/dune b/src/stdlib/dune deleted file mode 100644 index 6c0acc16a2..0000000000 --- a/src/stdlib/dune +++ /dev/null @@ -1,12 +0,0 @@ -(env - (release - (ocamlopt_flags - (:standard -w -9 -alert --deprecated -O2))) - (_ - (flags - (:standard -w -9 -alert --deprecated)))) - -(library - (name liquidsoap_stdlib) - (wrapped false) - (libraries threads liquidsoap_lang)) diff --git a/src/stdlib/hashtbl.ml b/src/stdlib/hashtbl.ml deleted file mode 100644 index 00627f5a19..0000000000 --- a/src/stdlib/hashtbl.ml +++ /dev/null @@ -1 +0,0 @@ -include Stdlib.Hashtbl diff --git a/src/stdlib/hashtbl.mli b/src/stdlib/hashtbl.mli deleted file mode 100644 index 5e8d17006a..0000000000 --- a/src/stdlib/hashtbl.mli +++ /dev/null @@ -1,17 +0,0 @@ -type (!'a, !'b) t = ('a, 'b) Stdlib.Hashtbl.t - -val create : ?random:bool -> int -> ('a, 'b) t -val length : ('a, 'b) t -> int -val copy : ('a, 'b) t -> ('a, 'b) t -val mem : ('a, 'b) t -> 'a -> bool -val find : ('a, 'b) t -> 'a -> 'b -val find_opt : ('a, 'b) t -> 'a -> 'b option -val remove : ('a, 'b) t -> 'a -> unit -val replace : ('a, 'b) t -> 'a -> 'b -> unit -val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit -val filter_map_inplace : ('a -> 'b -> 'b option) -> ('a, 'b) t -> unit -val fold : ('a -> 'b -> 'acc -> 'acc) -> ('a, 'b) t -> 'acc -> 'acc -val hash : 'a -> int -val reset : ('a, 'b) t -> unit - -module Make : module type of Stdlib.Hashtbl.Make diff --git a/src/stdlib/pcre.ml b/src/stdlib/pcre.ml deleted file mode 100644 index 68bbc5e16d..0000000000 --- a/src/stdlib/pcre.ml +++ /dev/null @@ -1 +0,0 @@ -include Re.Pcre diff --git a/src/stdlib/pcre.mli b/src/stdlib/pcre.mli deleted file mode 100644 index 9d0cbfad59..0000000000 --- a/src/stdlib/pcre.mli +++ /dev/null @@ -1 +0,0 @@ -include module type of Re.Pcre From 9c6036903a2930bee4cc15730429590a3183d527 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 15 Nov 2024 09:20:44 -0600 Subject: [PATCH 094/151] Remove this. --- .github/workflows/ci.yml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index ad315403c9..6908597441 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -235,10 +235,6 @@ jobs: sudo -u opam -E git remote set-url origin https://github.com/savonet/liquidsoap.git sudo -u opam -E git fetch origin ${{ github.sha }} sudo -u opam -E git checkout ${{ github.sha }} - - name: Install sqlite - run: | - sudo apt-get -y install libsqlite3-dev - sudo -u opam -E opam install -y sqlite3 - name: Install pandoc run: | cd /tmp From 34f50be83e9487abf1398c86b252039ca7d6b860 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 15 Nov 2024 16:11:57 -0600 Subject: [PATCH 095/151] Revert "Remove this." This reverts commit 9c6036903a2930bee4cc15730429590a3183d527. --- .github/workflows/ci.yml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 6908597441..e1a9714e0d 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -235,6 +235,11 @@ jobs: sudo -u opam -E git remote set-url origin https://github.com/savonet/liquidsoap.git sudo -u opam -E git fetch origin ${{ github.sha }} sudo -u opam -E git checkout ${{ github.sha }} + - name: Install sqlite + run: | + sudo apt-get -y update + sudo apt-get -y install libsqlite3-dev + sudo -u opam -E opam install -y sqlite3 - name: Install pandoc run: | cd /tmp From 44eb58d7315e897d545db3add0d62ff01b47860b Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 18 Nov 2024 09:32:59 -0600 Subject: [PATCH 096/151] Factor out Http auth parse logic, test it. (#4211) --- src/core/harbor/harbor.ml | 19 +++++++------------ src/core/tools/liq_http.ml | 8 ++++++++ src/core/tools/liq_http.mli | 7 ++++++- tests/core/dune.inc | 14 ++++++++++++++ tests/core/http_test.ml | 4 ++++ 5 files changed, 39 insertions(+), 13 deletions(-) create mode 100644 tests/core/http_test.ml diff --git a/src/core/harbor/harbor.ml b/src/core/harbor/harbor.ml index aed4436454..83ffffef9a 100644 --- a/src/core/harbor/harbor.ml +++ b/src/core/harbor/harbor.ml @@ -361,11 +361,9 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let websocket_error n msg = Websocket.to_string (`Close (Some (n, msg))) let parse_icy_request_line ~port h r = - let auth_data = Re.Pcre.split ~rex:(Re.Pcre.regexp ":") r in - let requested_user, password = - match auth_data with - | user :: password :: _ -> (user, password) - | _ -> ("", r) + let { Liq_http.user = requested_user; password } = + try Liq_http.parse_auth r + with Not_found -> { Liq_http.user = ""; password = r } in let* s = try Duppy.Monad.return (find_source "/" (port - 1)) @@ -451,14 +449,11 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let auth = assoc_uppercase "AUTHORIZATION" headers in let data = Re.Pcre.split ~rex:(Re.Pcre.regexp "[ \t]+") auth in match data with - | "Basic" :: x :: _ -> ( - let auth_data = - Re.Pcre.split ~rex:(Re.Pcre.regexp ":") - (Lang_string.decode64 x) + | "Basic" :: x :: _ -> + let { Liq_http.user; password } = + Liq_http.parse_auth (Lang_string.decode64 x) in - match auth_data with - | x :: y :: _ -> (x, y) - | _ -> raise Not_found) + (user, password) | _ -> raise Not_found with Not_found -> ( match query with diff --git a/src/core/tools/liq_http.ml b/src/core/tools/liq_http.ml index d6eae3835c..4fa9466c9e 100644 --- a/src/core/tools/liq_http.ml +++ b/src/core/tools/liq_http.ml @@ -206,3 +206,11 @@ let set_socket_default ~read_timeout ~write_timeout fd = Unix.set_close_on_exec fd; Unix.setsockopt_float fd Unix.SO_RCVTIMEO read_timeout; Unix.setsockopt_float fd Unix.SO_SNDTIMEO write_timeout + +type auth = { user : string; password : string } + +let parse_auth s = + match Re.Pcre.split ~rex:(Re.Pcre.regexp ":") s with + | user :: (_ :: _ as password) -> + { user; password = String.concat ":" password } + | _ -> raise Not_found diff --git a/src/core/tools/liq_http.mli b/src/core/tools/liq_http.mli index 3351886686..d47bcde1e2 100644 --- a/src/core/tools/liq_http.mli +++ b/src/core/tools/liq_http.mli @@ -76,5 +76,10 @@ val read : timeout:float -> socket -> int -> string (** Read [len] bytes *) val really_read : timeout:float -> socket -> int -> string -(* Read chunked data. *) +(** Read chunked data. *) val read_chunked : timeout:float -> socket -> string * int + +type auth = { user : string; password : string } + +(** Split authentication string. Raises [Not_found] if failed. *) +val parse_auth : string -> auth diff --git a/tests/core/dune.inc b/tests/core/dune.inc index 2a45450f8b..d1ac0fc5e3 100644 --- a/tests/core/dune.inc +++ b/tests/core/dune.inc @@ -83,6 +83,20 @@ (action (run %{generator_test} ))) +(executable + (name http_test) + (modules http_test) + (libraries liquidsoap_core liquidsoap_optionals)) + +(rule + (alias citest) + (package liquidsoap) + (deps + + (:http_test http_test.exe)) + (action (run %{http_test} ))) + + (executable (name is_url) (modules is_url) diff --git a/tests/core/http_test.ml b/tests/core/http_test.ml new file mode 100644 index 0000000000..0fb43a09fa --- /dev/null +++ b/tests/core/http_test.ml @@ -0,0 +1,4 @@ +let () = + let { Liq_http.user; password } = Liq_http.parse_auth "foo:bar:gni" in + assert (user = "foo"); + assert (password = "bar:gni") From 6f399bab4ad3381c2fe8ece8c5dbc090e4d1bb83 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 18 Nov 2024 10:03:32 -0600 Subject: [PATCH 097/151] Fix override implementation logic. --- src/libs/autocue.liq | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index ad1856ddab..ca98462130 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -997,7 +997,7 @@ def enable_autocue_metadata() = user_supplied_amplify = list.filter_map( fun (el) -> - if list.mem(fst(el), all_amplify) then snd(el) else null() end, + if list.mem(fst(el), all_amplify) then fst(el) else null() end, metadata ) From 8588ac8086fbe47744f9f43aa0bb216d272e4157 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 18 Nov 2024 12:53:19 -0600 Subject: [PATCH 098/151] Strip implicit tracks when evaluating values. (#4212) --- src/core/hooks_implementations.ml | 29 +++++++++++++++++++++++++++-- src/lang/type.mli | 3 +++ src/lang/types/type_base.ml | 19 +++++++++++++++++++ src/lang/typing.ml | 19 ------------------- 4 files changed, 49 insertions(+), 21 deletions(-) diff --git a/src/core/hooks_implementations.ml b/src/core/hooks_implementations.ml index 28c252dba6..51d2d24a43 100644 --- a/src/core/hooks_implementations.ml +++ b/src/core/hooks_implementations.ml @@ -11,16 +11,41 @@ let rec deep_demeth t = | Type.{ descr = Nullable t } -> deep_demeth t | t -> t +let strip_tracks ty = + let ty = Type.hide_meth "track_marks" ty in + Type.hide_meth "metadata" ty + +let strip_source_tracks ty = + match Type.deref ty with + | Type. + { + descr = + Constr { constructor = "source"; params = [(`Invariant, frame_t)] }; + } -> + Type. + { + ty with + descr = + Constr + { + constructor = "source"; + params = [(`Invariant, strip_tracks frame_t)]; + }; + } + | _ -> ty + let eval_check ~env:_ ~tm v = if Lang_source.Source_val.is_value v then ( let s = Lang_source.Source_val.of_value v in if not s#has_content_type then ( let ty = Type.fresh (deep_demeth tm.Term.t) in - Typing.(Lang_source.source_t ~methods:false s#frame_type <: ty); + Typing.( + Lang_source.source_t ~methods:false (strip_tracks s#frame_type) + <: strip_source_tracks ty); s#content_type_computation_allowed)) else if Source_tracks.is_value v then ( let s = Source_tracks.source v in - Typing.(s#frame_type <: Type.fresh tm.Term.t)) + Typing.(strip_tracks s#frame_type <: strip_tracks (Type.fresh tm.Term.t))) else if Track.is_value v then ( let field, source = Lang_source.to_track v in if not source#has_content_type then ( diff --git a/src/lang/type.mli b/src/lang/type.mli index 32fa659f55..78e412a74d 100644 --- a/src/lang/type.mli +++ b/src/lang/type.mli @@ -160,6 +160,9 @@ val reference : ?pos:Pos.t -> t -> t val meths : ?pos:Pos.t -> string list -> scheme -> t -> t val split_meths : t -> meth list * t +val hide_meth : string -> t -> t +val opt_meth : string -> t -> t +val get_meth : string -> t -> meth val filter_meths : t -> (meth -> bool) -> t val var : ?constraints:constr list -> ?level:int -> ?pos:Pos.t -> unit -> t val mk_invariant : t -> unit diff --git a/src/lang/types/type_base.ml b/src/lang/types/type_base.ml index 3c6c834517..804c428507 100644 --- a/src/lang/types/type_base.ml +++ b/src/lang/types/type_base.ml @@ -420,3 +420,22 @@ let rec mk_invariant t = c.contents <- Link (`Invariant, t); mk_invariant t | _ -> () + +let rec hide_meth l a = + match (deref a).descr with + | Meth ({ meth = l' }, u) when l' = l -> hide_meth l u + | Meth (m, u) -> make ?pos:a.pos (Meth (m, hide_meth l u)) + | _ -> a + +let rec opt_meth l a = + match (deref a).descr with + | Meth (({ meth = l' } as m), u) when l' = l -> + make ?pos:a.pos (Meth ({ m with optional = true }, u)) + | Meth (m, u) -> make ?pos:a.pos (Meth (m, opt_meth l u)) + | _ -> a + +let rec get_meth l a = + match (deref a).descr with + | Meth (({ meth = l' } as meth), _) when l = l' -> meth + | Meth (_, a) -> get_meth l a + | _ -> assert false diff --git a/src/lang/typing.ml b/src/lang/typing.ml index bceb0e8cfd..1bab9d6db1 100644 --- a/src/lang/typing.ml +++ b/src/lang/typing.ml @@ -36,25 +36,6 @@ let forget_arguments = true type env = (string * scheme) list -let rec hide_meth l a = - match (deref a).descr with - | Meth ({ meth = l' }, u) when l' = l -> hide_meth l u - | Meth (m, u) -> Type.make ?pos:a.pos (Meth (m, hide_meth l u)) - | _ -> a - -let rec opt_meth l a = - match (deref a).descr with - | Meth (({ meth = l' } as m), u) when l' = l -> - Type.make ?pos:a.pos (Meth ({ m with optional = true }, u)) - | Meth (m, u) -> Type.make ?pos:a.pos (Meth (m, opt_meth l u)) - | _ -> a - -let rec get_meth l a = - match (deref a).descr with - | Meth (({ meth = l' } as meth), _) when l = l' -> meth - | Meth (_, a) -> get_meth l a - | _ -> assert false - (** {1 Type generalization and instantiation} We don't have type schemes per se, but we compute generalizable variables From 88f92566011c98e5458359b3819c8d7798dae148 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 18 Nov 2024 16:10:55 -0600 Subject: [PATCH 099/151] Update log. --- src/core/outputs/output.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/outputs/output.ml b/src/core/outputs/output.ml index 402ea7da51..fdd892d212 100644 --- a/src/core/outputs/output.ml +++ b/src/core/outputs/output.ml @@ -182,7 +182,7 @@ class virtual output ~output_kind ?clock ?(name = "") ~infallible if not self#fallible then ( self#log#critical "Infallible source produced a partial frame!"; assert false); - self#log#important "Source failed (no more tracks) stopping output..."; + self#log#important "Source ended (no more tracks) stopping output..."; self#transition_to `Idle); if skip then ( From d2cb821693c2c0605e3d9dafdf6100313ca285cc Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 18 Nov 2024 19:06:23 -0600 Subject: [PATCH 100/151] Add global meta setting to amplify. (#4213) --- src/core/operators/amplify.ml | 18 ++++++++++-------- src/libs/tracks.liq | 22 ++++++++++++++++++++++ 2 files changed, 32 insertions(+), 8 deletions(-) diff --git a/src/core/operators/amplify.ml b/src/core/operators/amplify.ml index 7e3bc3e5ff..5577406a79 100644 --- a/src/core/operators/amplify.ml +++ b/src/core/operators/amplify.ml @@ -26,7 +26,7 @@ open Source let parse_db s = try Scanf.sscanf s " %f dB" Audio.lin_of_dB with _ -> float_of_string s -class amplify ~field (source : source) override_field coeff = +class amplify ~field ~override_field (source : source) coeff = object (self) inherit operator ~name:"track.audio.amplify" [source] val mutable override = None @@ -63,7 +63,7 @@ class amplify ~field (source : source) override_field coeff = else buf method private set_override buf = - match override_field with + match Option.map (fun f -> f ()) override_field with | Some f -> if override <> None then self#log#info "End of the current overriding."; @@ -92,9 +92,8 @@ let _ = let frame_t = Lang.pcm_audio_t () in Lang.add_track_operator ~base:Modules.track_audio "amplify" [ - ("", Lang.getter_t Lang.float_t, None, Some "Multiplicative factor."); ( "override", - Lang.nullable_t Lang.string_t, + Lang.getter_t (Lang.nullable_t Lang.string_t), Some (Lang.string "liq_amplify"), Some "Specify the name of a metadata field that, when present and \ @@ -102,7 +101,9 @@ let _ = track. Well-formed values are floats in decimal notation (e.g. \ `0.7`) which are taken as normal/linear multiplicative factors; \ values can be passed in decibels with the suffix `dB` (e.g. `-8.2 \ - dB`, but the spaces do not matter)." ); + dB`, but the spaces do not matter). Defaults to \ + `settings.amplify.metadata`. Set to `null` to disable." ); + ("", Lang.getter_t Lang.float_t, None, Some "Multiplicative factor."); ("", frame_t, None, None); ] ~return_t:frame_t ~category:`Audio @@ -110,6 +111,7 @@ let _ = (fun p -> let c = Lang.to_float_getter (Lang.assoc "" 1 p) in let field, s = Lang.to_track (Lang.assoc "" 2 p) in - let o = Lang.to_option (Lang.assoc "override" 1 p) in - let o = Option.map Lang.to_string o in - (field, new amplify ~field s o c)) + let override_field = + Lang.to_valued_option Lang.to_string_getter (Lang.assoc "override" 1 p) + in + (field, new amplify ~field ~override_field s c)) diff --git a/src/libs/tracks.liq b/src/libs/tracks.liq index 5e6e160b7c..0eaf8f243e 100644 --- a/src/libs/tracks.liq +++ b/src/libs/tracks.liq @@ -61,3 +61,25 @@ def source.drop.metadata(~id=null(), s) = let {metadata = _, ...tracks} = source.tracks(s) source(id=id, tracks) end + +let settings.amplify = + settings.make.void( + "Settings for the amplify operator" + ) + +let settings.amplify.override = + settings.make( + description= + "Default metadata used to override amplification.", + "liq_amplify" + ) + +# @docof track.audio.amplify +def track.audio.amplify( + %argsof(track.audio.amplify[!override]), + ~override=getter({(settings.amplify.override() : string?)}), + v, + t +) = + track.audio.amplify(%argsof(track.audio.amplify), v, t) +end From cf3fd6248a01d77ba5b04da5410e125822901856 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 18 Nov 2024 22:33:57 -0600 Subject: [PATCH 101/151] Remove this. --- src/core/builtins/builtins_request.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/core/builtins/builtins_request.ml b/src/core/builtins/builtins_request.ml index 3fb1b53ca3..5ac113a6a4 100644 --- a/src/core/builtins/builtins_request.ml +++ b/src/core/builtins/builtins_request.ml @@ -111,9 +111,7 @@ let _ = ~descr: "Resolve a request, i.e. attempt to get a valid local file. The \ operation can take some time. Return true if the resolving was \ - successful, false otherwise (timeout or invalid URI). The request \ - should not be decoded afterward: this is mostly useful to download \ - files such as playlists, etc." + successful, false otherwise (timeout or invalid URI)." (fun p -> let timeout = Lang.to_valued_option Lang.to_float (List.assoc "timeout" p) From df2b1b2dbb3c23c3d85ca0771b483afa2c4dda37 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 19 Nov 2024 00:13:39 -0600 Subject: [PATCH 102/151] Better clock filter. --- src/core/clock.ml | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/core/clock.ml b/src/core/clock.ml index 8002883d8f..b1da4168a5 100644 --- a/src/core/clock.ml +++ b/src/core/clock.ml @@ -204,6 +204,9 @@ let sources c = @ Queue.elements outputs | _ -> [] +(* Return the clock effective sync. Stopped clocks can + be unified with any active type clocks so [`Stopped _] returns + [`Stopped]. *) let _sync ?(pending = false) x = match Atomic.get x.state with | `Stopped p when pending -> (p :> sync_mode) @@ -211,6 +214,12 @@ let _sync ?(pending = false) x = | `Stopping _ -> `Stopping | `Started { sync } -> (sync :> sync_mode) +(* Return the current sync, used to make decisions based on the + clock's sync value, regardless of potential unification. *) +let active_sync_mode c = + match Atomic.get (Unifier.deref c).state with + | `Stopped sync | `Stopping { sync } | `Started { sync } -> sync + let sync c = _sync (Unifier.deref c) let cleanup_source s = try s#force_sleep with _ -> () let clocks = Queue.create () @@ -261,7 +270,7 @@ let unify = Queue.flush_iter clock.on_error (Queue.push clock'.on_error); Unifier.(clock.id <-- clock'.id); Unifier.(c <-- c'); - Queue.filter clocks (fun el -> sync el <> `Passive && el != c) + Queue.filter clocks (fun el -> active_sync_mode el <> `Passive && el != c) in fun ~pos c c' -> let _c = Unifier.deref c in From ef2a2dbfc2cf5c3fc52a5a27f468b8548679af49 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 19 Nov 2024 17:08:05 -0600 Subject: [PATCH 103/151] Remove `source.{dump, drop}`, add `request.{dump, process}`. (#4216) --- CHANGES.md | 3 + doc/content/migrating.md | 6 +- doc/content/threads.md | 11 +- src/core/builtins/builtins_request.ml | 189 ++++++++++++++++++++++++++ src/core/builtins/builtins_source.ml | 141 ------------------- src/core/clock.ml | 69 ++++------ src/core/lang_source.ml | 14 +- src/core/outputs/output.ml | 2 +- src/core/source.ml | 9 +- src/core/sources/request_dynamic.ml | 6 +- src/core/stream/content_base.ml | 2 +- src/libs/autocue.liq | 55 +++----- src/libs/playlist.liq | 23 +--- src/libs/protocols.liq | 18 ++- src/libs/replaygain.liq | 14 +- src/libs/tracks.liq | 2 + 16 files changed, 291 insertions(+), 273 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 633777dd1e..fde6df39d1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -74,6 +74,9 @@ Changed: now returns `max_int` and `int(-infinity)` returns `min_int`. (#3407) - Made default font a setting (#3507) - Changed internal metadata format to be immutable (#3297). +- Removed `source.dump` and `source.drop` in favor of safer `request.dump` and `request.drop`. + `source.{dump, drop}` can still be implemented manually when needed and with the proper + knowledge of what's going on. - Allow a getter for the offset of `on_offset` and dropped the metadata mechanism for updating it (#3355). - `string.length` and `string.sub` now default to `utf8` encoding (#4109) diff --git a/doc/content/migrating.md b/doc/content/migrating.md index 3a99da33b5..78aae83543 100644 --- a/doc/content/migrating.md +++ b/doc/content/migrating.md @@ -78,8 +78,7 @@ end ### Thread queues -In order to improve issues with complex inter-dependent asynchronous tasks such as `autocue` data computation, -scheduler queues have been improved. +In order to improve issues with complex inter-dependent asynchronous tasks, scheduler queues have been updated. User-provided named queues can now be created and used to send asynchronous tasks, making it possible to control concurrency of certain classes of tasks and also to remedy any potential dependency between asynchronous tasks. @@ -101,8 +100,7 @@ asynchronous tasks sent to. Likewise, `request.dynamic`, `playlist`, `single` etc. have also been updated to accept a `thread_queue` argument controlling which asynchronous queue their request resolution tasks should be sent to. -See [the original Pull Request)[https://github.com/savonet/liquidsoap/pull/4151) and [the threads page](threads.html) -for more details. +See [the threads page](threads.html) for more details. ### Replaygain diff --git a/doc/content/threads.md b/doc/content/threads.md index 68d07cb990..45eca25668 100644 --- a/doc/content/threads.md +++ b/doc/content/threads.md @@ -19,7 +19,7 @@ By default, there are two type of queues available in liquidsoap: - `non_blocking` queues By convention, tasks that are known to be executing very fast should be sent to the -`non_blockin` queues and all the other tasks should be sent to the `generic` queue. +`non_blocking` queues and all the other tasks should be sent to the `generic` queue. You can decide which queue to send tasks to by using the `queue` parameter of the `thread.run` functions. Some other operators who also use threads can have a similar @@ -35,12 +35,3 @@ This is particularly useful for two applications: - To control concurrent execution of specific tasks. - To prevent deadlocks in case some tasks depends on other tasks. - -Typically, `autocue` data resolution is executed inside a `request` resolution. To -control the concurrency with which this CPU-intensive task is executed, we place them -in a specific queue. The number of queues controls how many of these tasks can be executed -concurrently. - -Also, this prevents a deadlock where all the request resolution fill up the available -`generic` queues, making it impossible for the autocue computation to finish, thus preventing -the request resolution from returning. diff --git a/src/core/builtins/builtins_request.ml b/src/core/builtins/builtins_request.ml index 5ac113a6a4..9a6daa8b5f 100644 --- a/src/core/builtins/builtins_request.ml +++ b/src/core/builtins/builtins_request.ml @@ -21,6 +21,11 @@ *****************************************************************************) let request = Modules.request +let should_stop = Atomic.make false + +let () = + Lifecycle.before_core_shutdown ~name:"builtin source shutdown" (fun () -> + Atomic.set should_stop true) let _ = Lang.add_builtin ~base:request "all" ~category:`Liquidsoap @@ -295,3 +300,187 @@ let _ = | `Failed -> "failed" in Lang.string s) + +exception Process_failed + +class process ~name r = + object (self) + inherit + Request_dynamic.dynamic + ~name ~priority:`Non_blocking + ~retry_delay:(fun _ -> 0.1) + ~available:(fun _ -> true) + (Lang.val_fun [] (fun _ -> Lang.null)) + 1 None + + initializer + self#on_wake_up (fun () -> + match Request.get_decoder ~ctype:self#content_type r with + | Some _ -> self#set_queue [r] + | None | (exception _) -> raise Process_failed) + end + +let process_request ~log ~name ~ratio ~timeout ~sleep_latency ~process r = + let module Time = (val Clock.time_implementation () : Liq_time.T) in + let open Time in + let start_time = Time.time () in + match Request.resolve ~timeout r with + | `Failed | `Timeout -> () + | `Resolved -> ( + let timeout = Time.of_float timeout in + let timeout_time = Time.(start_time |+| timeout) in + try + let s = new process ~name r in + let s = (process (s :> Source.source) :> Source.source) in + let clock = + Clock.create ~id:name ~sync:`Passive + ~on_error:(fun exn bt -> + Utils.log_exception ~log + ~bt:(Printexc.raw_backtrace_to_string bt) + (Printf.sprintf "Error while processing source: %s" + (Printexc.to_string exn)); + raise Process_failed) + () + in + Fun.protect + ~finally:(fun () -> try Clock.stop clock with _ -> ()) + (fun () -> + let started = ref false in + let stopped = ref false in + let _ = + new Output.dummy + ~clock ~infallible:false ~register_telnet:false + ~on_start:(fun () -> started := true) + ~on_stop:(fun () -> stopped := true) + ~autostart:true (Lang.source s) + in + Clock.start ~force:true clock; + log#info "Start streaming loop (ratio: %.02fx)" ratio; + let sleep_latency = Time.of_float sleep_latency in + let target_time () = + Time.( + start_time |+| sleep_latency + |+| of_float (Clock.time clock /. ratio)) + in + while (not (Atomic.get should_stop)) && not !stopped do + if (not !started) && Time.(timeout_time |<=| Time.time ()) then ( + log#important + "Timeout while waiting for the source to be ready!"; + raise Process_failed) + else ( + Clock.tick clock; + let target_time = target_time () in + if Time.(time () |<| (target_time |+| sleep_latency)) then + sleep_until target_time) + done; + let processing_time = Time.(to_float (time () |-| start_time)) in + let effective_ratio = Clock.time clock /. processing_time in + log#info + "Request processed. Total processing time: %.02fs, effective \ + ratio: %.02fx" + processing_time effective_ratio) + with Process_failed | Clock.Has_stopped -> ()) + +let _ = + let log = Log.make ["request"; "dump"] in + let kind = Lang.univ_t () in + Lang.add_builtin ~base:request "dump" ~category:(`Source `Liquidsoap) + ~descr:"Immediately encode the whole contents of a request into a file." + ~flags:[`Experimental] + [ + ("", Lang.format_t kind, None, Some "Encoding format."); + ("", Lang.string_t, None, Some "Name of the file."); + ("", Request.Value.t, None, Some "Request to encode."); + ( "ratio", + Lang.float_t, + Some (Lang.float 50.), + Some + "Time ratio. A value of `50` means process data at `50x` real rate, \ + when possible." ); + ( "timeout", + Lang.float_t, + Some (Lang.float 1.), + Some + "Stop processing the source if it has not started after the given \ + timeout." ); + ( "sleep_latency", + Lang.float_t, + Some (Lang.float 0.1), + Some + "How much time ahead, in seconds, should we should be before pausing \ + the processing." ); + ] + Lang.unit_t + (fun p -> + let proto = + let p = Pipe_output.file_proto (Lang.univ_t ()) in + List.filter_map (fun (l, _, v, _) -> Option.map (fun v -> (l, v)) v) p + in + let proto = ("fallible", Lang.bool true) :: proto in + let format = Lang.assoc "" 1 p in + let file = Lang.assoc "" 2 p in + let r = Request.Value.of_value (Lang.assoc "" 3 p) in + let process s = + let p = + ("id", Lang.string "request.drop") + :: ("", format) :: ("", file) + :: ("", Lang.source s) + :: (p @ proto) + in + Pipe_output.new_file_output p + in + let ratio = Lang.to_float (List.assoc "ratio" p) in + let timeout = Lang.to_float (List.assoc "timeout" p) in + let sleep_latency = Lang.to_float (List.assoc "sleep_latency" p) in + process_request ~log ~name:"request.dump" ~ratio ~timeout ~sleep_latency + ~process r; + log#info "Request dumped."; + Lang.unit) + +let _ = + let log = Log.make ["request"; "process"] in + Lang.add_builtin ~base:request "process" ~category:(`Source `Liquidsoap) + ~descr: + "Given a request and an optional function to process this request, \ + animate the source as fast as possible until the request is fully \ + processed." + [ + ("", Request.Value.t, None, Some "Request to process"); + ( "process", + Lang.fun_t + [(false, "", Lang.source_t (Lang.univ_t ()))] + (Lang.source_t (Lang.univ_t ())), + Some (Lang.val_fun [("", "", None)] (fun p -> List.assoc "" p)), + Some "Callback to create the source to animate." ); + ( "ratio", + Lang.float_t, + Some (Lang.float 50.), + Some + "Time ratio. A value of `50` means process data at `50x` real rate, \ + when possible." ); + ( "timeout", + Lang.float_t, + Some (Lang.float 1.), + Some + "Stop processing the source if it has not started after the given \ + timeout." ); + ( "sleep_latency", + Lang.float_t, + Some (Lang.float 0.1), + Some + "How much time ahead, in seconds, should we should be before pausing \ + the processing." ); + ] + Lang.unit_t + (fun p -> + let r = Request.Value.of_value (List.assoc "" p) in + let process = List.assoc "process" p in + let process s = + Lang.to_source (Lang.apply process [("", Lang.source s)]) + in + let ratio = Lang.to_float (List.assoc "ratio" p) in + let timeout = Lang.to_float (List.assoc "timeout" p) in + let sleep_latency = Lang.to_float (List.assoc "sleep_latency" p) in + process_request ~log ~name:"request.process" ~ratio ~timeout + ~sleep_latency ~process r; + Lang.unit) diff --git a/src/core/builtins/builtins_source.ml b/src/core/builtins/builtins_source.ml index b1f7db39c0..db5614a960 100644 --- a/src/core/builtins/builtins_source.ml +++ b/src/core/builtins/builtins_source.ml @@ -21,11 +21,6 @@ *****************************************************************************) let source = Muxer.source -let should_stop = Atomic.make false - -let () = - Lifecycle.before_core_shutdown ~name:"builtin source shutdown" (fun () -> - Atomic.set should_stop true) let _ = Lang.add_builtin ~base:source "set_name" ~category:(`Source `Liquidsoap) @@ -161,139 +156,3 @@ let _ = let wrap_f () = ignore (Lang.apply f []) in s#on_sleep wrap_f; Lang.unit) - -let flush_source ~log ~name ~ratio ~timeout ~sleep_latency s = - let module Time = (val Clock.time_implementation () : Liq_time.T) in - let open Time in - let started = ref false in - let stopped = ref false in - let clock = - Clock.create ~id:name ~sync:`Passive - ~on_error:(fun exn bt -> - stopped := true; - Utils.log_exception ~log - ~bt:(Printexc.raw_backtrace_to_string bt) - (Printf.sprintf "Error while processing source: %s" - (Printexc.to_string exn))) - () - in - let _ = - new Output.dummy - ~clock ~infallible:false - ~on_start:(fun () -> started := true) - ~on_stop:(fun () -> stopped := true) - ~register_telnet:false ~autostart:true (Lang.source s) - in - Clock.start ~force:true clock; - log#info "Start source streaming loop (ratio: %.02fx)" ratio; - let start_time = Time.time () in - let timeout = Time.of_float timeout in - let timeout_time = Time.(start_time |+| timeout) in - let sleep_latency = Time.of_float sleep_latency in - let target_time () = - Time.(start_time |+| sleep_latency |+| of_float (Clock.time clock /. ratio)) - in - (try - while (not (Atomic.get should_stop)) && not !stopped do - if (not !started) && Time.(timeout_time |<=| start_time) then ( - log#important "Timeout while waiting for the source to start!"; - stopped := true) - else ( - Clock.tick clock; - let target_time = target_time () in - if Time.(time () |<| (target_time |+| sleep_latency)) then - sleep_until target_time) - done - with Clock.Has_stopped -> ()); - let processing_time = Time.(to_float (time () |-| start_time)) in - let effective_ratio = Clock.time clock /. processing_time in - log#info - "Source processed. Total processing time: %.02fs, effective ratio: %.02fx" - processing_time effective_ratio; - Clock.stop clock - -let flush_source ~log ~name ~ratio ~timeout ~sleep_latency s = - if Tutils.running () then - flush_source ~log ~name ~ratio ~timeout ~sleep_latency s - else log#important "Cannot run %s: scheduler not started!" name - -let _ = - let log = Log.make ["source"; "dump"] in - let kind = Lang.univ_t () in - Lang.add_builtin ~base:source "dump" ~category:(`Source `Liquidsoap) - ~descr:"Immediately encode the whole contents of a source into a file." - ~flags:[`Experimental] - [ - ("", Lang.format_t kind, None, Some "Encoding format."); - ("", Lang.string_t, None, Some "Name of the file."); - ("", Lang.source_t kind, None, Some "Source to encode."); - ( "ratio", - Lang.float_t, - Some (Lang.float 50.), - Some - "Time ratio. A value of `50` means process data at `50x` real rate, \ - when possible." ); - ( "timeout", - Lang.float_t, - Some (Lang.float 1.), - Some - "Stop processing the source if it has not started after the given \ - timeout." ); - ( "sleep_latency", - Lang.float_t, - Some (Lang.float 0.1), - Some - "How much time ahead, in seconds, should we should be before pausing \ - the processing." ); - ] - Lang.unit_t - (fun p -> - let proto = - let p = Pipe_output.file_proto (Lang.univ_t ()) in - List.filter_map (fun (l, _, v, _) -> Option.map (fun v -> (l, v)) v) p - in - let proto = ("fallible", Lang.bool true) :: proto in - let p = (("id", Lang.string "source.drop") :: p) @ proto in - let s = Pipe_output.new_file_output p in - let ratio = Lang.to_float (List.assoc "ratio" p) in - let timeout = Lang.to_float (List.assoc "timeout" p) in - let sleep_latency = Lang.to_float (List.assoc "sleep_latency" p) in - flush_source ~log ~name:"source.dump" ~ratio ~timeout ~sleep_latency - (s :> Source.source); - log#info "Source dumped."; - Lang.unit) - -let _ = - let log = Log.make ["source"; "drop"] in - Lang.add_builtin ~base:source "drop" ~category:(`Source `Liquidsoap) - ~descr:"Animate the source as fast as possible, dropping its output." - ~flags:[`Experimental] - [ - ("", Lang.source_t (Lang.univ_t ()), None, Some "Source to animate."); - ( "ratio", - Lang.float_t, - Some (Lang.float 50.), - Some - "Time ratio. A value of `50` means process data at `50x` real rate, \ - when possible." ); - ( "timeout", - Lang.float_t, - Some (Lang.float 1.), - Some - "Stop processing the source if it has not started after the given \ - timeout." ); - ( "sleep_latency", - Lang.float_t, - Some (Lang.float 0.1), - Some - "How much time ahead, in seconds, should we should be before pausing \ - the processing." ); - ] - Lang.unit_t - (fun p -> - let s = List.assoc "" p |> Lang.to_source in - let ratio = Lang.to_float (List.assoc "ratio" p) in - let timeout = Lang.to_float (List.assoc "timeout" p) in - let sleep_latency = Lang.to_float (List.assoc "sleep_latency" p) in - flush_source ~log ~name:"source.dump" ~ratio ~timeout ~sleep_latency s; - Lang.unit) diff --git a/src/core/clock.ml b/src/core/clock.ml index b1da4168a5..7089e9de5b 100644 --- a/src/core/clock.ml +++ b/src/core/clock.ml @@ -45,26 +45,6 @@ let log = Log.make ["clock"] let conf_clock = Dtools.Conf.void ~p:(Configure.conf#plug "clock") "Clock settings" -(** If true, a clock keeps running when an output fails. Other outputs may - * still be useful. But there may also be some useless inputs left. - * If no active output remains, the clock will exit without triggering - * shutdown. We may need some device to allow this (but active and passive - * clocks will have to be treated separately). *) -let allow_streaming_errors = - Dtools.Conf.bool - ~p:(conf_clock#plug "allow_streaming_errors") - ~d:false "Handling of streaming errors" - ~comments: - [ - "Control the behaviour of clocks when an error occurs during streaming."; - "This has no effect on errors occurring during source initializations."; - "By default, any error will cause liquidsoap to shutdown. If errors"; - "are allowed, faulty sources are simply removed and clocks keep \ - running."; - "Allowing errors can result in complex surprising situations;"; - "use at your own risk!"; - ] - let conf_log_delay = Dtools.Conf.float ~p:(conf_clock#plug "log_delay") @@ -380,6 +360,20 @@ let started c = | `Stopping _ | `Started _ -> true | `Stopped _ -> false +let wrap_errors clock fn s = + try fn s + with exn when exn <> Has_stopped -> + let bt = Printexc.get_raw_backtrace () in + Printf.printf "Error: %s\n%s\n%!" (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt); + log#severe "Source %s failed while streaming: %s!\n%s" s#id + (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt); + _detach clock s; + if Queue.length clock.on_error > 0 then + Queue.iter clock.on_error (fun fn -> fn exn bt) + else Printexc.raise_with_backtrace exn bt + let rec active_params c = match Atomic.get (Unifier.deref c).state with | `Stopping s | `Started s -> s @@ -387,13 +381,14 @@ let rec active_params c = | _ -> raise Invalid_state and _activate_pending_sources ~clock x = - Queue.flush_iter clock.pending_activations (fun s -> - check_stopped (); - s#wake_up; - match s#source_type with - | `Active _ -> WeakQueue.push x.active_sources s - | `Output _ -> Queue.push x.outputs s - | `Passive -> WeakQueue.push x.passive_sources s) + Queue.flush_iter clock.pending_activations + (wrap_errors clock (fun s -> + check_stopped (); + s#wake_up; + match s#source_type with + | `Active _ -> WeakQueue.push x.active_sources s + | `Output _ -> Queue.push x.outputs s + | `Passive -> WeakQueue.push x.passive_sources s)) and _tick ~clock x = _activate_pending_sources ~clock x; @@ -402,21 +397,11 @@ and _tick ~clock x = in let sources = _animated_sources x in List.iter - (fun s -> - check_stopped (); - try - match s#source_type with - | `Output s | `Active s -> s#output - | _ -> assert false - with exn when exn <> Has_stopped -> - let bt = Printexc.get_raw_backtrace () in - if Queue.is_empty clock.on_error then ( - log#severe "Source %s failed while streaming: %s!\n%s" s#id - (Printexc.to_string exn) - (Printexc.raw_backtrace_to_string bt); - if not allow_streaming_errors#get then Tutils.shutdown 1 - else _detach clock s) - else Queue.iter clock.on_error (fun fn -> fn exn bt)) + (wrap_errors clock (fun s -> + check_stopped (); + match s#source_type with + | `Output s | `Active s -> s#output + | _ -> assert false)) sources; Queue.flush_iter x.on_tick (fun fn -> check_stopped (); diff --git a/src/core/lang_source.ml b/src/core/lang_source.ml index b34070636d..f00e120bcb 100644 --- a/src/core/lang_source.ml +++ b/src/core/lang_source.ml @@ -55,15 +55,16 @@ module ClockValue = struct Lang.val_fun [] (fun _ -> Lang.string Clock.(string_of_sync_mode (sync c))) ); ( "start", - Lang.fun_t [] Lang.unit_t, + Lang.fun_t [(true, "force", Lang.bool_t)] Lang.unit_t, "Start the clock.", fun c -> Lang.val_fun - [("", "", Some (Lang.string "auto"))] + [("force", "force", Some (Lang.bool true))] (fun p -> let pos = Lang.pos p in + let force = Lang.to_bool (List.assoc "force" p) in try - Clock.start c; + Clock.start ~force c; Lang.unit with Clock.Invalid_state -> Runtime_error.raise @@ -94,6 +95,13 @@ module ClockValue = struct let c' = of_value (List.assoc "" p) in Clock.unify ~pos c c'; Lang.unit) ); + ( "tick", + Lang.fun_t [] Lang.unit_t, + "Animate the clock and run one tick", + fun c -> + Lang.val_fun [] (fun _ -> + Clock.tick c; + Lang.unit) ); ( "ticks", Lang.fun_t [] Lang.int_t, "The total number of times the clock has ticked.", diff --git a/src/core/outputs/output.ml b/src/core/outputs/output.ml index fdd892d212..a2622a88c1 100644 --- a/src/core/outputs/output.ml +++ b/src/core/outputs/output.ml @@ -182,7 +182,7 @@ class virtual output ~output_kind ?clock ?(name = "") ~infallible if not self#fallible then ( self#log#critical "Infallible source produced a partial frame!"; assert false); - self#log#important "Source ended (no more tracks) stopping output..."; + self#log#info "Source ended (no more tracks) stopping output..."; self#transition_to `Idle); if skip then ( diff --git a/src/core/source.ml b/src/core/source.ml index d3bd3103e0..8fe69c738d 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -242,11 +242,12 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources = List.iter (fun fn -> fn ()) on_wake_up with exn -> Atomic.set is_up `Error; - let bt = Printexc.get_backtrace () in - Utils.log_exception ~log ~bt - (Printf.sprintf "Error when starting source %s: %s!" self#id + let bt = Printexc.get_raw_backtrace () in + Utils.log_exception ~log + ~bt:(Printexc.raw_backtrace_to_string bt) + (Printf.sprintf "Error while starting source %s: %s!" self#id (Printexc.to_string exn)); - Tutils.shutdown 1) + Printexc.raise_with_backtrace exn bt) val mutable on_sleep = [] method on_sleep fn = on_sleep <- fn :: on_sleep diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml index 8995487d85..b3aa692b2c 100644 --- a/src/core/sources/request_dynamic.ml +++ b/src/core/sources/request_dynamic.ml @@ -59,11 +59,11 @@ let () = Lifecycle.before_core_shutdown ~name:"request.dynamic shutdown" (fun () -> Atomic.set should_fail true) -class dynamic ~priority ~retry_delay ~available (f : Lang.value) prefetch - timeout = +class dynamic ?(name = "request.dynamic") ~priority ~retry_delay ~available + (f : Lang.value) prefetch timeout = let available () = (not (Atomic.get should_fail)) && available () in object (self) - inherit source ~name:"request.dynamic" () + inherit source ~name () method fallible = true val mutable remaining = 0 method remaining = remaining diff --git a/src/core/stream/content_base.ml b/src/core/stream/content_base.ml index 02146d373d..ad93d9bfde 100644 --- a/src/core/stream/content_base.ml +++ b/src/core/stream/content_base.ml @@ -330,7 +330,7 @@ module MkContentBase (C : ContentSpecs) : let consolidate_chunks = let consolidate_chunk ~buf pos ({ data; offset } as chunk) = let length = chunk_length chunk in - C.blit data offset buf pos length; + if length > 0 then C.blit data offset buf pos length; pos + length in fun ~copy d -> diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index ca98462130..b262242965 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -59,25 +59,6 @@ let settings.autocue.internal.metadata_override = ] ) -let settings.autocue.internal.queues_count = - settings.make( - description= - "Number of dedicated queues for resolving autocue data using the internal \ - implementation", - 1 - ) - -def settings.autocue.internal.queues_count.set(c) = - settings.scheduler.queues := - [ - ...list.assoc.remove("autocue", settings.scheduler.queues()), - ("autocue", c) - ] - settings.autocue.internal.queues_count.set(c) -end - -settings.autocue.internal.queues_count.set(1) - let settings.autocue.internal.lufs_target = settings.make( description= @@ -206,30 +187,30 @@ def autocue.internal.ebur128(~duration, ~ratio=50., ~timeout=10., filename) = ) [] else - s = - request.once( - thread_queue="autocue", request.create(resolve_metadata=false, filename) - ) + r = request.create(resolve_metadata=false, filename) frames = ref([]) - def ebur128(s) = - def mk_filter(graph) = - let {audio = a} = source.tracks(s) - a = ffmpeg.filter.audio.input(graph, a) - let ([a], _) = ffmpeg.filter.ebur128(metadata=true, graph, a) + def process(s) = + def ebur128(s) = + def mk_filter(graph) = + let {audio = a} = source.tracks(s) + a = ffmpeg.filter.audio.input(graph, a) + let ([a], _) = ffmpeg.filter.ebur128(metadata=true, graph, a) + + # ebur filter seems to generate invalid PTS. + a = ffmpeg.filter.asetpts(expr="N/SR/TB", graph, a) + a = ffmpeg.filter.audio.output(id="filter_output", graph, a) + source({audio=a, metadata=track.metadata(a)}) + end - # ebur filter seems to generate invalid PTS. - a = ffmpeg.filter.asetpts(expr="N/SR/TB", graph, a) - a = ffmpeg.filter.audio.output(id="filter_output", graph, a) - source({audio=a, metadata=track.metadata(a)}) + ffmpeg.filter.create(mk_filter) end - ffmpeg.filter.create(mk_filter) + s = ebur128(s) + source.on_metadata(s, fun (m) -> frames := [...frames(), m]) end - s = ebur128(s) - s = source.on_metadata(s, fun (m) -> frames := [...frames(), m]) - source.drop(ratio=ratio, s) + request.process(ratio=ratio, process=process, r) frames() end @@ -794,7 +775,7 @@ def autocue.internal.implementation( fade_out_type?: string, fade_out_curve?: float, start_next?: float, - extra_metadata?: [(string*string)] + extra_metadata?: [(string * string)] } ) end diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq index 1885731c72..89251c94c9 100644 --- a/src/libs/playlist.liq +++ b/src/libs/playlist.liq @@ -100,17 +100,8 @@ end # @category File # @param ~mime_type Default MIME type for the playlist. `null` means automatic detection. # @param ~timeout Timeout for resolving the playlist -# @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. -# @param ~cue_out_metadata Metadata for cue out points. Disabled if `null`. # @param uri Path to the playlist -def playlist.files( - ~id=null(), - ~mime_type=null(), - ~timeout=null(), - ~cue_in_metadata=null("liq_cue_in"), - ~cue_out_metadata=null("liq_cue_out"), - uri -) = +def playlist.files(~id=null(), ~mime_type=null(), ~timeout=null(), uri) = id = id ?? playlist.id(default="playlist.files", uri) if @@ -124,10 +115,7 @@ def playlist.files( files = list.filter(fun (f) -> not (file.is_directory(f)), files) files else - pl = - request.create( - cue_in_metadata=cue_in_metadata, cue_out_metadata=cue_out_metadata, uri - ) + pl = request.create(resolve_metadata=false, uri) result = if request.resolve(timeout=timeout, pl) @@ -533,12 +521,7 @@ def replaces playlist( files = try playlist.files( - id=id, - mime_type=mime_type, - timeout=timeout, - cue_in_metadata=cue_in_metadata, - cue_out_metadata=cue_out_metadata, - playlist_uri + id=id, mime_type=mime_type, timeout=timeout, playlist_uri ) catch err do log.info( diff --git a/src/libs/protocols.liq b/src/libs/protocols.liq index afa8d7b1c4..4f4b92be4c 100644 --- a/src/libs/protocols.liq +++ b/src/libs/protocols.liq @@ -660,9 +660,7 @@ def protocol.stereo(~rlog=_, ~maxtime=_, arg) = ) null() else - # TODO: the following sometimes hangs, so we resolve twice... - # source.dump(%wav, file, source.stereo(once(request.queue(queue=[r])))) - source.dump(%wav, file, stereo(once(single(arg)))) + request.dump(%wav, file, request.create(arg)) file end end @@ -1066,7 +1064,19 @@ def synth_protocol(~rlog=_, ~maxtime=_, text) = label="synth", "Synthesizing #{shape()} in #{file}." ) - source.dump(%wav, file, once(s)) + + clock.assign_new(sync="passive", [s]) + + stopped = ref(false) + output.file( + fallible=true, on_stop={stopped.set(true)}, %wav, file, once(s) + ) + + c = clock(s.clock) + c.start() + while not stopped() do c.tick() end + c.stop() + file end diff --git a/src/libs/replaygain.liq b/src/libs/replaygain.liq index 14d28a9f89..65da5042f7 100644 --- a/src/libs/replaygain.liq +++ b/src/libs/replaygain.liq @@ -22,9 +22,17 @@ def file.replaygain.compute(~ratio=50., file_name) = if request.resolve(_request) then - _source = source.replaygain.compute(request.once(_request)) - source.drop(ratio=ratio, _source) - _source.gain() + get_gain = ref(fun () -> null()) + def process(s) = + s = source.replaygain.compute(s) + get_gain := {s.gain()} + s + end + + request.process(ratio=ratio, process=process, _request) + + fn = get_gain() + fn() else null() end diff --git a/src/libs/tracks.liq b/src/libs/tracks.liq index 0eaf8f243e..9d0affa81c 100644 --- a/src/libs/tracks.liq +++ b/src/libs/tracks.liq @@ -34,6 +34,8 @@ def source.mux.midi(~id=null(), ~(midi:source), s) = source(id=id, source.tracks(s).{midi=source.tracks(midi).midi}) end +let source.drop = () + # Remove the audio track of a source. # @category Source / Track processing def source.drop.audio(~id=null(), s) = From f823959c458e92d47cff2afa98bebd7bc2ee8ec5 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 21 Nov 2024 22:56:23 -0600 Subject: [PATCH 104/151] Cleanup single fallible case. (#4218) --- src/core/builtins/builtins_request.ml | 19 ++++++- src/core/sources/request_dynamic.ml | 72 ++++++++++++++++++--------- src/libs/extra/native.liq | 1 + src/libs/request.liq | 53 +++++++++++++++----- 4 files changed, 107 insertions(+), 38 deletions(-) diff --git a/src/core/builtins/builtins_request.ml b/src/core/builtins/builtins_request.ml index 9a6daa8b5f..3829033ad3 100644 --- a/src/core/builtins/builtins_request.ml +++ b/src/core/builtins/builtins_request.ml @@ -110,6 +110,12 @@ let _ = Some "Limit in seconds to the duration of the request resolution. \ Defaults to `settings.request.timeout` when `null`." ); + ( "content_type", + Lang.nullable_t (Lang.source_t (Lang.univ_t ())), + Some Lang.null, + Some + "Check that the request can decode content suitable for the given \ + source." ); ("", Request.Value.t, None, None); ] Lang.bool_t @@ -121,8 +127,17 @@ let _ = let timeout = Lang.to_valued_option Lang.to_float (List.assoc "timeout" p) in + let source = + Lang.to_valued_option Lang.to_source (List.assoc "content_type" p) + in let r = Request.Value.of_value (List.assoc "" p) in - Lang.bool (try Request.resolve ?timeout r = `Resolved with _ -> false)) + Lang.bool + (match (Request.resolve ?timeout r, source) with + | `Resolved, Some s -> ( + try Request.get_decoder ~ctype:s#content_type r <> None + with _ -> false) + | `Resolved, None -> true + | _ | (exception _) -> false)) let _ = Lang.add_builtin ~base:request "metadata" ~category:`Liquidsoap @@ -310,8 +325,8 @@ class process ~name r = ~name ~priority:`Non_blocking ~retry_delay:(fun _ -> 0.1) ~available:(fun _ -> true) + ~prefetch:1 ~timeout:None ~synchronous:true (Lang.val_fun [] (fun _ -> Lang.null)) - 1 None initializer self#on_wake_up (fun () -> diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml index b3aa692b2c..4f16c3d1c0 100644 --- a/src/core/sources/request_dynamic.ml +++ b/src/core/sources/request_dynamic.ml @@ -39,6 +39,8 @@ type handler = { close : unit -> unit; } +type task = { notify : unit -> unit; stop : unit -> unit } + let log_failed_request (log : Log.t) request ans = log#important "Could not resolve request %s: %s." (Request.initial_uri request) @@ -47,12 +49,6 @@ let log_failed_request (log : Log.t) request ans = | `Timeout -> "timeout" | `Resolved -> "file could not be decoded with the correct content") -let extract_queued_params p = - let l = Lang.to_valued_option Lang.to_int (List.assoc "prefetch" p) in - let l = Option.value ~default:conf_prefetch#get l in - let t = Lang.to_valued_option Lang.to_float (List.assoc "timeout" p) in - (l, t) - let should_fail = Atomic.make false let () = @@ -60,7 +56,7 @@ let () = Atomic.set should_fail true) class dynamic ?(name = "request.dynamic") ~priority ~retry_delay ~available - (f : Lang.value) prefetch timeout = + ~prefetch ~synchronous ~timeout f = let available () = (not (Atomic.get should_fail)) && available () in object (self) inherit source ~name () @@ -180,17 +176,16 @@ class dynamic ?(name = "request.dynamic") ~priority ~retry_delay ~available method seek_source = (self :> Source.source) method abort_track = Atomic.set should_skip true + method private is_request_ready = + self#current <> None || try self#fetch_request with _ -> false + method can_generate_frame = - let is_ready = - (fun () -> - self#current <> None || try self#fetch_request with _ -> false) - () - in - match is_ready with + match self#is_request_ready with | true -> true | false -> if available () then self#notify_new_request; - false + (* Try one more time in case a new request was queued above. *) + self#is_request_ready val retrieved : queue_item Queue.t = Queue.create () method private queue_size = Queue.length retrieved @@ -219,11 +214,24 @@ class dynamic ?(name = "request.dynamic") ~priority ~retry_delay ~available initializer self#on_wake_up (fun () -> - let t = Duppy.Async.add Tutils.scheduler ~priority self#feed_queue in - Duppy.Async.wake_up t; + let task = + if synchronous then + { + notify = (fun () -> self#synchronous_feed_queue); + stop = (fun () -> ()); + } + else ( + let t = + Duppy.Async.add Tutils.scheduler ~priority self#feed_queue + in + { + notify = (fun () -> Duppy.Async.wake_up t); + stop = (fun () -> Duppy.Async.stop t); + }) + in assert ( Atomic.compare_and_set state `Sleeping - (`Started (Unix.gettimeofday (), t)))) + (`Started (Unix.gettimeofday (), task)))) method private clear_retrieved = let rec clear () = @@ -238,8 +246,8 @@ class dynamic ?(name = "request.dynamic") ~priority ~retry_delay ~available initializer self#on_sleep (fun () -> match Atomic.exchange state `Sleeping with - | `Started (_, t) -> - Duppy.Async.stop t; + | `Started (_, { stop }) -> + stop (); (* No more feeding task, we can go to sleep. *) self#end_request; self#log#info "Cleaning up request queue..."; @@ -250,8 +258,7 @@ class dynamic ?(name = "request.dynamic") ~priority ~retry_delay ~available opportunity to feed the queue, in case it is sleeping. *) method private notify_new_request = match Atomic.get state with - | `Started (d, t) when d <= Unix.gettimeofday () -> - Duppy.Async.wake_up t + | `Started (d, { notify }) when d <= Unix.gettimeofday () -> notify () | _ -> () (** The body of the feeding task *) @@ -266,6 +273,11 @@ class dynamic ?(name = "request.dynamic") ~priority ~retry_delay ~available d) | _ -> -1. + method private synchronous_feed_queue = + match self#feed_queue () with + | 0. -> self#synchronous_feed_queue + | _ -> () + method fetch = try let r = @@ -350,6 +362,12 @@ let _ = Some "Whether some new requests are available (when set to false, it \ stops after current playing request)." ); + ( "synchronous", + Lang.bool_t, + Some (Lang.bool false), + Some + "If `true`, new requests are prepared as needed instead of using an \ + asynchronous queue." ); ( "prefetch", Lang.nullable_t Lang.int_t, Some Lang.null, @@ -435,5 +453,13 @@ let _ = | "non_blocking" -> `Non_blocking | n -> `Named n in - let l, t = extract_queued_params p in - new dynamic ~available ~priority ~retry_delay f l t) + let prefetch = + Lang.to_valued_option Lang.to_int (List.assoc "prefetch" p) + in + let prefetch = Option.value ~default:conf_prefetch#get prefetch in + let synchronous = Lang.to_bool (List.assoc "synchronous" p) in + let timeout = + Lang.to_valued_option Lang.to_float (List.assoc "timeout" p) + in + new dynamic + ~available ~priority ~retry_delay ~prefetch ~timeout ~synchronous f) diff --git a/src/libs/extra/native.liq b/src/libs/extra/native.liq index 4cfdfa5f86..a7ead829e5 100644 --- a/src/libs/extra/native.liq +++ b/src/libs/extra/native.liq @@ -89,6 +89,7 @@ def native.request.dynamic(%argsof(request.dynamic), f) = ignore(available) ignore(timeout) ignore(native) + ignore(synchronous) def f() = try diff --git a/src/libs/request.liq b/src/libs/request.liq index c2dc9ade09..130dc8de86 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -280,7 +280,7 @@ def request.single( ) = id = string.id.default(default="single", id) - fallible = fallible ?? getter.is_constant(r) + fallible = fallible ?? not getter.is_constant(r) infallible = if @@ -302,9 +302,20 @@ def request.single( false end + if + not fallible and not infallible + then + log.severe( + label=id, + "Source was marked a infallible but its request is not a static file. The \ + source is considered fallible for backward compatibility but this will \ + fail in future versions!" + ) + end + static_request = ref(null()) - def on_wake_up() = + def on_wake_up(s) = if infallible then @@ -315,8 +326,9 @@ def request.single( label=id, "#{uri} is static, resolving once for all..." ) + if - not request.resolve(initial_request, timeout=timeout) + not request.resolve(initial_request, timeout=timeout, content_type=s) then request.destroy(initial_request) error.raise( @@ -339,20 +351,35 @@ def request.single( end def next() = - def next() = - static_request() ?? getter.get(r) - end + static_request() ?? getter.get(r) + end - s = request.dynamic(prefetch=prefetch, thread_queue=thread_queue, next) - if infallible then s.set_queue([next()]) end - s + def mk_source(id) = + request.dynamic( + id=id, + prefetch=prefetch, + thread_queue=thread_queue, + synchronous=infallible, + next + ) end + # We want to mark infallible source as such. `source.dynamic` is a nice + # way to do it as it will raise a user-friendly error in case the underlying + # source does not respect the conditions for being infallible. s = - source.dynamic( - id=id, infallible=infallible, self_sync=false, track_sensitive=true, next - ) - s.on_wake_up(on_wake_up) + if + infallible + then + s = mk_source("#{id}.actual") + source.dynamic( + id=id, infallible=infallible, self_sync=false, track_sensitive=true, {s} + ) + else + mk_source(id) + end + + s.on_wake_up(fun () -> on_wake_up(s)) s.on_shutdown(on_shutdown) (s : source_methods) end From faffb13fea416f4772aaf324fc005835e09c6931 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 22 Nov 2024 08:15:45 -0600 Subject: [PATCH 105/151] Bring back default telnet commands. --- src/libs/request.liq | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/request.liq b/src/libs/request.liq index 130dc8de86..8ecf2172bf 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -34,7 +34,7 @@ end # @method length Length of the queue. def request.queue( ~id=null(), - ~interactive=false, + ~interactive=true, ~prefetch=null(), ~native=false, ~queue=[], From b18d14a52a518f4b2ddf4a44c69a30698703b082 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 23 Nov 2024 09:27:02 -0600 Subject: [PATCH 106/151] Revert scheduler changes. (#4219) --- CHANGES.md | 2 - doc/content/liq/radiopi.liq | 6 + doc/content/liq/task-example.liq | 5 - doc/content/liq/task-with-queue.liq | 12 - doc/content/migrating.md | 26 --- doc/content/threads.md | 37 --- doc/dune.inc | 297 ------------------------- src/core/builtins/builtins_request.ml | 2 +- src/core/builtins/builtins_settings.ml | 27 +-- src/core/builtins/builtins_socket.ml | 6 +- src/core/builtins/builtins_thread.ml | 22 +- src/core/decoder/external_decoder.ml | 2 +- src/core/file_watcher.inotify.ml | 2 +- src/core/file_watcher.mtime.ml | 8 +- src/core/harbor/harbor.ml | 10 +- src/core/io/ffmpeg_io.ml | 2 +- src/core/io/srt_io.ml | 4 +- src/core/operators/pipe.ml | 2 +- src/core/outputs/harbor_output.ml | 8 +- src/core/sources/request_dynamic.ml | 20 +- src/core/tools/external_input.ml | 2 +- src/core/tools/liqfm.ml | 2 +- src/core/tools/server.ml | 2 +- src/core/tools/tutils.ml | 108 ++++----- src/core/tools/tutils.mli | 7 +- src/libs/extra/deprecations.liq | 9 +- src/libs/extra/native.liq | 2 +- src/libs/extra/visualization.liq | 4 +- src/libs/playlist.liq | 14 +- src/libs/request.liq | 14 +- src/libs/thread.liq | 16 +- tests/language/error.liq | 2 +- 32 files changed, 136 insertions(+), 546 deletions(-) delete mode 100644 doc/content/liq/task-example.liq delete mode 100644 doc/content/liq/task-with-queue.liq delete mode 100644 doc/content/threads.md diff --git a/CHANGES.md b/CHANGES.md index fde6df39d1..5c695618c0 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -35,8 +35,6 @@ New: - Added `video.canvas` to make it possible to position video elements independently of the rendered video size ([#3656](https://github.com/savonet/liquidsoap/pull/3656), [blog post](https://www.liquidsoap.info/blog/2024-02-10-video-canvas-and-ai/)) - Added cover manager from an original code by @vitoyucepi (#3651) -- Reworked scheduler queues logic, allow user-defined queues, add options to pick - the queue to send asynchronous tasks to (#4151) - Added non-interleaved API to `%ffmpeg` encoder, enabled by default when only one stream is encoded. - Allow trailing commas in record definition (#3300). diff --git a/doc/content/liq/radiopi.liq b/doc/content/liq/radiopi.liq index 9dd5e57b70..06553b29bd 100644 --- a/doc/content/liq/radiopi.liq +++ b/doc/content/liq/radiopi.liq @@ -16,6 +16,12 @@ settings.harbor.bind_addrs.set(["0.0.0.0"]) # Verbose logs log.level.set(4) +# We use the scheduler intensively, +# therefore we create many queues. +settings.scheduler.generic_queues.set(5) +settings.scheduler.fast_queues.set(3) +settings.scheduler.non_blocking_queues.set(3) + # === Settings === # The host to request files diff --git a/doc/content/liq/task-example.liq b/doc/content/liq/task-example.liq deleted file mode 100644 index b667f0083d..0000000000 --- a/doc/content/liq/task-example.liq +++ /dev/null @@ -1,5 +0,0 @@ -def connect_callback() = - ignore(http.post("http://host/on_connect")) -end - -thread.run(connect_callback) diff --git a/doc/content/liq/task-with-queue.liq b/doc/content/liq/task-with-queue.liq deleted file mode 100644 index d07692d499..0000000000 --- a/doc/content/liq/task-with-queue.liq +++ /dev/null @@ -1,12 +0,0 @@ -# Add 3 foo queue -settings.scheduler.queues.set([ - ...settings.scheduler.queues(), - ("foo", 3) -]) - -def connect_callback() = - ignore(http.post("http://host/on_connect")) -end - -# Execute inside the foo queue -thread.run(queue="foo", connect_callback) diff --git a/doc/content/migrating.md b/doc/content/migrating.md index 78aae83543..1bffd2a362 100644 --- a/doc/content/migrating.md +++ b/doc/content/migrating.md @@ -76,32 +76,6 @@ def transition(old, new) = end ``` -### Thread queues - -In order to improve issues with complex inter-dependent asynchronous tasks, scheduler queues have been updated. - -User-provided named queues can now be created and used to send asynchronous tasks, making it possible to control -concurrency of certain classes of tasks and also to remedy any potential dependency between asynchronous tasks. - -Settings for queues have thus changed and now will look like this: - -```liquidsoap -# Add a custom queue with 4 workers, increase generic queues to 4: -settings.scheduler.queues.set([ - ...list.assoc,remove("generic", settings.scheduler.queues()), - ("generic", 4), - ("custom", 4) -] -``` - -The `fast` argument of the `thread.run.*` functions has been replaced by `queue`, telling the operator which queue should the -asynchronous tasks sent to. - -Likewise, `request.dynamic`, `playlist`, `single` etc. have also been updated to accept a `thread_queue` argument controlling -which asynchronous queue their request resolution tasks should be sent to. - -See [the threads page](threads.html) for more details. - ### Replaygain - There is a new `metadata.replaygain` function that extracts the replay gain value in _dB_ from the metadata. diff --git a/doc/content/threads.md b/doc/content/threads.md deleted file mode 100644 index 45eca25668..0000000000 --- a/doc/content/threads.md +++ /dev/null @@ -1,37 +0,0 @@ -# Threads - -The main purpose of liquidsoap is to create real time media streams. When streams are created, everything that -is needed to compute them needs to happen very quickly so that we make sure that the stream can in fact -be created in real time. - -When a task is required that may take some time and whose result is not required for the stream generation, -for instance when executing a `on_stop` or `on_connect` callback, it can be useful to execute this task in a _thread_. - -Threads in liquidsoap are callback functions that are executed by an asynchronous queue. Here's an example: - -```{.liquidsoap include="task-example.liq"} - -``` - -By default, there are two type of queues available in liquidsoap: - -- `generic` queues -- `non_blocking` queues - -By convention, tasks that are known to be executing very fast should be sent to the -`non_blocking` queues and all the other tasks should be sent to the `generic` queue. - -You can decide which queue to send tasks to by using the `queue` parameter of the -`thread.run` functions. Some other operators who also use threads can have a similar -parameter such as `thread_queue` for `request.dynamic` and `playlist`. - -You can also define your own named queue using the `settings.scheduler.queues` setting. - -```{.liquidsoap include="task-with-queue.liq"} - -``` - -This is particularly useful for two applications: - -- To control concurrent execution of specific tasks. -- To prevent deadlocks in case some tasks depends on other tasks. diff --git a/doc/dune.inc b/doc/dune.inc index eab98186d9..0f1f2fdff0 100644 --- a/doc/dune.inc +++ b/doc/dune.inc @@ -167,8 +167,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -297,8 +295,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -427,8 +423,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -557,8 +551,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -687,8 +679,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -817,8 +807,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -947,8 +935,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1077,8 +1063,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1207,8 +1191,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1337,8 +1319,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1467,8 +1447,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1597,8 +1575,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1727,8 +1703,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1857,8 +1831,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -1987,8 +1959,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2117,8 +2087,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2247,8 +2215,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2377,8 +2343,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2507,8 +2471,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2637,8 +2599,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2767,8 +2727,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -2897,8 +2855,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3027,8 +2983,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3157,8 +3111,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3287,8 +3239,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3417,8 +3367,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3547,8 +3495,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3677,8 +3623,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3807,8 +3751,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -3937,8 +3879,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4067,8 +4007,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4197,8 +4135,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4327,8 +4263,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4457,8 +4391,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4587,8 +4519,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4717,8 +4647,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4847,8 +4775,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -4977,8 +4903,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5107,8 +5031,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5237,8 +5159,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5367,8 +5287,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5497,8 +5415,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5627,8 +5543,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5757,8 +5671,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -5887,8 +5799,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6017,8 +5927,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6147,8 +6055,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6277,8 +6183,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6407,8 +6311,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6537,8 +6439,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6667,8 +6567,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6797,8 +6695,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -6927,8 +6823,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7057,8 +6951,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7187,8 +7079,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7317,8 +7207,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7447,8 +7335,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7577,8 +7463,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7707,8 +7591,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7837,8 +7719,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -7967,8 +7847,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8097,8 +7975,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8227,8 +8103,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8357,8 +8231,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8487,8 +8359,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8617,8 +8487,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8747,8 +8615,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -8877,8 +8743,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -9007,8 +8871,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -9137,8 +8999,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -9165,136 +9025,6 @@ ) ) -(rule - (alias doc) - (package liquidsoap) - (enabled_if (not %{bin-available:pandoc})) - (deps (:no_pandoc no-pandoc)) - (target threads.html) - (action (run cp %{no_pandoc} %{target})) -) - -(rule - (alias doc) - (package liquidsoap) - (enabled_if %{bin-available:pandoc}) - (deps - liquidsoap.xml - language.dtd - template.html - content/liq/append-silence.liq - content/liq/archive-cleaner.liq - content/liq/basic-radio.liq - content/liq/beets-amplify.liq - content/liq/beets-protocol-short.liq - content/liq/beets-protocol.liq - content/liq/beets-source.liq - content/liq/blank-detect.liq - content/liq/blank-sorry.liq - content/liq/complete-case.liq - content/liq/cross.custom.liq - content/liq/crossfade.liq - content/liq/decoder-faad.liq - content/liq/decoder-flac.liq - content/liq/decoder-metaflac.liq - content/liq/dump-hourly.liq - content/liq/dump-hourly2.liq - content/liq/dynamic-source.liq - content/liq/external-output.file.liq - content/liq/fallback.liq - content/liq/ffmpeg-filter-dynamic-volume.liq - content/liq/ffmpeg-filter-flanger-highpass.liq - content/liq/ffmpeg-filter-hflip.liq - content/liq/ffmpeg-filter-hflip2.liq - content/liq/ffmpeg-filter-parallel-flanger-highpass.liq - content/liq/ffmpeg-live-switch.liq - content/liq/ffmpeg-relay-ondemand.liq - content/liq/ffmpeg-relay.liq - content/liq/ffmpeg-shared-encoding-rtmp.liq - content/liq/ffmpeg-shared-encoding.liq - content/liq/fixed-time1.liq - content/liq/fixed-time2.liq - content/liq/frame-size.liq - content/liq/harbor-auth.liq - content/liq/harbor-dynamic.liq - content/liq/harbor-insert-metadata.liq - content/liq/harbor-metadata.liq - content/liq/harbor-redirect.liq - content/liq/harbor-simple.liq - content/liq/harbor-usage.liq - content/liq/harbor.http.register.liq - content/liq/harbor.http.response.liq - content/liq/hls-metadata.liq - content/liq/hls-mp4.liq - content/liq/http-input.liq - content/liq/icy-update.liq - content/liq/input.mplayer.liq - content/liq/jingle-hour.liq - content/liq/json-ex.liq - content/liq/json-stringify.liq - content/liq/json1.liq - content/liq/live-switch.liq - content/liq/medialib-predicate.liq - content/liq/medialib.liq - content/liq/medialib.sqlite.liq - content/liq/multitrack-add-video-track.liq - content/liq/multitrack-add-video-track2.liq - content/liq/multitrack-default-video-track.liq - content/liq/multitrack.liq - content/liq/multitrack2.liq - content/liq/multitrack3.liq - content/liq/output.file.hls.liq - content/liq/playlists.liq - content/liq/prometheus-callback.liq - content/liq/prometheus-settings.liq - content/liq/radiopi.liq - content/liq/re-encode.liq - content/liq/regular.liq - content/liq/replaygain-metadata.liq - content/liq/replaygain-playlist.liq - content/liq/request.dynamic.liq - content/liq/rtmp.liq - content/liq/samplerate3.liq - content/liq/scheduling.liq - content/liq/seek-telnet.liq - content/liq/settings.liq - content/liq/shoutcast.liq - content/liq/single.liq - content/liq/source-cue.liq - content/liq/space_overhead.liq - content/liq/split-cue.liq - content/liq/sqlite.liq - content/liq/srt-receiver.liq - content/liq/srt-sender.liq - content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq - content/liq/transcoding.liq - content/liq/video-anonymizer.liq - content/liq/video-bluescreen.liq - content/liq/video-canvas-example.liq - content/liq/video-default-canvas.liq - content/liq/video-in-video.liq - content/liq/video-logo.liq - content/liq/video-osc.liq - content/liq/video-simple.liq - content/liq/video-static.liq - content/liq/video-text.liq - content/liq/video-transition.liq - content/liq/video-weather.liq - content/liq/video-webcam.liq - (:md content/threads.md) - ) - (target threads.html) - (action - (pipe-stdout - (run pandoc %{md} -t json) - (run pandoc-include --directory content/liq) - (run pandoc -f json --syntax-definition=liquidsoap.xml --highlight=pygments --metadata pagetitle=threads --template=template.html -o %{target}) - ) - ) -) - (rule (alias doc) (package liquidsoap) @@ -9397,8 +9127,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -9527,8 +9255,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -9657,8 +9383,6 @@ content/liq/srt-receiver.liq content/liq/srt-sender.liq content/liq/switch-show.liq - content/liq/task-example.liq - content/liq/task-with-queue.liq content/liq/transcoding.liq content/liq/video-anonymizer.liq content/liq/video-bluescreen.liq @@ -10535,26 +10259,6 @@ (action (run %{bin:liquidsoap} --check --no-fallible-check content/liq/switch-show.liq)) ) -(rule - (alias doctest) - (package liquidsoap) - (deps - (source_tree ../src/libs) - (:test_liq content/liq/task-example.liq) - ) - (action (run %{bin:liquidsoap} --check --no-fallible-check content/liq/task-example.liq)) -) - -(rule - (alias doctest) - (package liquidsoap) - (deps - (source_tree ../src/libs) - (:test_liq content/liq/task-with-queue.liq) - ) - (action (run %{bin:liquidsoap} --check --no-fallible-check content/liq/task-with-queue.liq)) -) - (rule (alias doctest) (package liquidsoap) @@ -10790,7 +10494,6 @@ (stereotool.html as html/stereotool.html) (stream_content.html as html/stream_content.html) (strings_encoding.html as html/strings_encoding.html) - (threads.html as html/threads.html) (video-static.html as html/video-static.html) (video.html as html/video.html) (yaml.html as html/yaml.html) diff --git a/src/core/builtins/builtins_request.ml b/src/core/builtins/builtins_request.ml index 3829033ad3..559a355ddb 100644 --- a/src/core/builtins/builtins_request.ml +++ b/src/core/builtins/builtins_request.ml @@ -322,7 +322,7 @@ class process ~name r = object (self) inherit Request_dynamic.dynamic - ~name ~priority:`Non_blocking + ~name ~retry_delay:(fun _ -> 0.1) ~available:(fun _ -> true) ~prefetch:1 ~timeout:None ~synchronous:true diff --git a/src/core/builtins/builtins_settings.ml b/src/core/builtins/builtins_settings.ml index 9ba65972d3..db1a4e1d20 100644 --- a/src/core/builtins/builtins_settings.ml +++ b/src/core/builtins/builtins_settings.ml @@ -92,32 +92,22 @@ let settings_module = | ty, true -> Lang.fun_t [] ty | ty, false -> Lang.fun_t [] (Lang.nullable_t ty) in - let rec get_type ?(sub = []) ~label conf = + let rec get_type ?(sub = []) conf = let ty, has_default_value = get_conf_type conf in Lang.method_t (get_t ~has_default_value ty) - (set_t ty @ leaf_types conf @ sub - @ - if label = "scheduler" then - [ - ( "queues", - ( [], - Lang.ref_t - (Lang.list_t (Lang.product_t Lang.string_t Lang.int_t)) ), - "Scheduler queue configuration." ); - ] - else []) + (set_t ty @ leaf_types conf @ sub) and leaf_types conf = List.map (fun label -> - let ty = get_type ~label (conf#path [label]) in + let ty = get_type (conf#path [label]) in let label = Utils.normalize_parameter_string label in ( label, ([], ty), Printf.sprintf "Entry for configuration key %s" label )) conf#subs in - let settings_t = get_type ~label:"settings" Configure.conf in + let settings_t = get_type Configure.conf in let get_v fn conv_to conv_from conf = let get = Lang.val_fun [] (fun _ -> @@ -132,7 +122,7 @@ let settings_module = in (get, Some set) in - let rec get_value ?(sub = []) ~label conf = + let rec get_value ?(sub = []) conf = let to_v fn conv_to conv_from = try ignore (fn conf); @@ -154,8 +144,7 @@ let settings_module = with Found v -> v in Lang.meth get_v - ((if label = "scheduler" then [("queues", Tutils.queues_conf)] else []) - @ (if set_v <> None then [("set", Option.get set_v)] else []) + ((if set_v <> None then [("set", Option.get set_v)] else []) @ [ ("description", Lang.string (String.trim conf#descr)); ( "comments", @@ -165,11 +154,11 @@ let settings_module = and leaf_values conf = List.map (fun label -> - let v = get_value ~label (conf#path [label]) in + let v = get_value (conf#path [label]) in (Utils.normalize_parameter_string label, v)) conf#subs in - settings := get_value ~label:"settings" Configure.conf; + settings := get_value Configure.conf; ignore (Lang.add_builtin_value ~category:`Settings "settings" ~descr:"All settings." ~flags:[`Hidden] !settings settings_t)) diff --git a/src/core/builtins/builtins_socket.ml b/src/core/builtins/builtins_socket.ml index 4b278e8523..f001c4a8c6 100644 --- a/src/core/builtins/builtins_socket.ml +++ b/src/core/builtins/builtins_socket.ml @@ -230,7 +230,11 @@ module Socket_value = struct [] in Duppy.Task.add Tutils.scheduler - { Duppy.Task.priority = `Generic; events; handler = fn }; + { + Duppy.Task.priority = `Maybe_blocking; + events; + handler = fn; + }; Lang.unit) ); ] in diff --git a/src/core/builtins/builtins_thread.ml b/src/core/builtins/builtins_thread.ml index 0866e9d3fc..d567c0f898 100644 --- a/src/core/builtins/builtins_thread.ml +++ b/src/core/builtins/builtins_thread.ml @@ -40,14 +40,16 @@ let _ = let _ = Lang.add_builtin ~base:thread_run "recurrent" ~category:`Programming [ - ( "queue", - Lang.string_t, - Some (Lang.string "generic"), + ( "fast", + Lang.bool_t, + Some (Lang.bool true), Some - "Queue to use for the task. Should be one of: `\"generic\"` or \ - `\"non_blocking\"`. Non blocking should be reserved for tasks that \ - are known to complete quickly. You can also use declared via \ - `settings.scheduler.queues`." ); + "Whether the thread is supposed to return quickly or not. Typically, \ + blocking tasks (e.g. fetching data over the internet) should not be \ + considered to be fast. When set to `false` its priority will be \ + lowered below that of request resolutions and fast timeouts. This \ + is only effective if you set a dedicated queue for fast tasks, see \ + the \"scheduler\" settings for more details." ); ( "delay", Lang.float_t, Some (Lang.float 0.), @@ -72,10 +74,8 @@ let _ = let delay = Lang.to_float (List.assoc "delay" p) in let f = List.assoc "" p in let priority = - match Lang.to_string (List.assoc "queue" p) with - | "generic" -> `Generic - | "non_blocking" -> `Non_blocking - | n -> `Named n + if Lang.to_bool (List.assoc "fast" p) then `Maybe_blocking + else `Blocking in let on_error = Lang.to_option (List.assoc "on_error" p) in let on_error = diff --git a/src/core/decoder/external_decoder.ml b/src/core/decoder/external_decoder.ml index efca33e872..2a60670808 100644 --- a/src/core/decoder/external_decoder.ml +++ b/src/core/decoder/external_decoder.ml @@ -49,7 +49,7 @@ let external_input process input = in let log s = log#important "%s" s in (* reading from input is blocking.. *) - let priority = `Generic in + let priority = `Blocking in let process = Process_handler.run ~priority ~on_stdin ~on_stderr ~log process in diff --git a/src/core/file_watcher.inotify.ml b/src/core/file_watcher.inotify.ml index 3ac1c84a26..8cde27f23c 100644 --- a/src/core/file_watcher.inotify.ml +++ b/src/core/file_watcher.inotify.ml @@ -53,7 +53,7 @@ let rec watchdog () = events; [watchdog ()]) in - { Duppy.Task.priority = `Generic; events = [`Read fd]; handler } + { Duppy.Task.priority = `Maybe_blocking; events = [`Read fd]; handler } let watch : watch = fun ~pos e file f -> diff --git a/src/core/file_watcher.mtime.ml b/src/core/file_watcher.mtime.ml index 2df0c6ea9a..58a89af598 100644 --- a/src/core/file_watcher.mtime.ml +++ b/src/core/file_watcher.mtime.ml @@ -61,7 +61,7 @@ let rec handler _ = (Printf.sprintf "Error while executing file watcher callback: %s" (Printexc.to_string exn))) !watched; - [{ Duppy.Task.priority = `Generic; events = [`Delay 1.]; handler }]) + [{ Duppy.Task.priority = `Maybe_blocking; events = [`Delay 1.]; handler }]) () let watch : watch = @@ -73,7 +73,11 @@ let watch : watch = if not !launched then begin launched := true; Duppy.Task.add Tutils.scheduler - { Duppy.Task.priority = `Generic; events = [`Delay 1.]; handler } + { + Duppy.Task.priority = `Maybe_blocking; + events = [`Delay 1.]; + handler; + } end; let mtime = try file_mtime file with _ -> 0. in watched := { file; mtime; callback } :: !watched; diff --git a/src/core/harbor/harbor.ml b/src/core/harbor/harbor.ml index 83ffffef9a..ae6df292d8 100644 --- a/src/core/harbor/harbor.ml +++ b/src/core/harbor/harbor.ml @@ -372,7 +372,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct simple_reply "No / mountpoint\r\n\r\n" in (* Authentication can be blocking. *) - Duppy.Monad.Io.exec ~priority:`Generic h + Duppy.Monad.Io.exec ~priority:`Maybe_blocking h (let user, auth_f = s#login in let user = if requested_user = "" then user else requested_user in if auth_f ~socket:h.Duppy.Monad.Io.socket user password then @@ -484,7 +484,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct Hashtbl.fold (fun lbl k query -> (lbl, k) :: query) query []) args in - Duppy.Monad.Io.exec ~priority:`Generic h + Duppy.Monad.Io.exec ~priority:`Maybe_blocking h (http_auth_check ?query ~login h.Duppy.Monad.Io.socket headers) (* We do not implement anything with this handler for now. *) @@ -627,7 +627,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct (Bytes.of_string (Websocket.upgrade headers)) in let* stype, huri, user, password = - Duppy.Monad.Io.exec ~priority:`Generic h + Duppy.Monad.Io.exec ~priority:`Blocking h (read_hello h.Duppy.Monad.Io.socket) in log#info "Mime type: %s" stype; @@ -895,7 +895,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct fun timeout -> fst (Http.read_chunked ~timeout socket) | _ -> fun _ -> "" in - Duppy.Monad.Io.exec ~priority:`Generic h + Duppy.Monad.Io.exec ~priority:`Maybe_blocking h (handler ~protocol ~meth ~headers ~data ~socket:h.Duppy.Monad.Io.socket ~query base_uri) | e -> @@ -965,7 +965,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct ~priority: (* ICY = true means that authentication has already happened *) - `Generic h + `Maybe_blocking h (let valid_user, auth_f = s#login in if not diff --git a/src/core/io/ffmpeg_io.ml b/src/core/io/ffmpeg_io.ml index 189821de85..ed2380f936 100644 --- a/src/core/io/ffmpeg_io.ml +++ b/src/core/io/ffmpeg_io.ml @@ -200,7 +200,7 @@ class input ?(name = "input.ffmpeg") ~autostart ~self_sync ~poll_delay ~debug | Some t -> Duppy.Async.wake_up t | None -> let t = - Duppy.Async.add ~priority:`Generic Tutils.scheduler + Duppy.Async.add ~priority:`Blocking Tutils.scheduler self#connect_task in Atomic.set connect_task (Some t); diff --git a/src/core/io/srt_io.ml b/src/core/io/srt_io.ml index 0d0ad63855..54bc148a30 100644 --- a/src/core/io/srt_io.ml +++ b/src/core/io/srt_io.ml @@ -358,7 +358,7 @@ module Poll = struct (Printexc.to_string exn)); -1. - let task = Duppy.Async.add ~priority:`Generic Tutils.scheduler process + let task = Duppy.Async.add ~priority:`Blocking Tutils.scheduler process let add_socket ~mode socket fn = Srt.setsockflag socket Srt.sndsyn false; @@ -532,7 +532,7 @@ class virtual caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid | Some t -> Duppy.Async.wake_up t | None -> let t = - Duppy.Async.add ~priority:`Generic Tutils.scheduler + Duppy.Async.add ~priority:`Blocking Tutils.scheduler self#connect_fn in connect_task <- Some t; diff --git a/src/core/operators/pipe.ml b/src/core/operators/pipe.ml index d371255dba..480ef0649b 100644 --- a/src/core/operators/pipe.ml +++ b/src/core/operators/pipe.ml @@ -254,7 +254,7 @@ class pipe ~replay_delay ~data_len ~process ~bufferize ~max ~restart Some (Process_handler.run ~on_stop:self#on_stop ~on_start:self#on_start ~on_stdout:self#on_stdout ~on_stdin:self#on_stdin - ~priority:`Generic ~on_stderr:self#on_stderr ~log process)) + ~priority:`Blocking ~on_stderr:self#on_stderr ~log process)) method! abort_track = source#abort_track diff --git a/src/core/outputs/harbor_output.ml b/src/core/outputs/harbor_output.ml index ff3534c27c..fab2ffca67 100644 --- a/src/core/outputs/harbor_output.ml +++ b/src/core/outputs/harbor_output.ml @@ -261,7 +261,7 @@ let add_meta c data = let rec client_task c = let* data = - Duppy.Monad.Io.exec ~priority:`Generic c.handler + Duppy.Monad.Io.exec ~priority:`Maybe_blocking c.handler (Mutex_utils.mutexify c.mutex (fun () -> let buflen = Strings.Mutable.length c.buffer in @@ -283,7 +283,7 @@ let rec client_task c = c.handler (Strings.to_bytes data) in let* state = - Duppy.Monad.Io.exec ~priority:`Generic c.handler + Duppy.Monad.Io.exec ~priority:`Maybe_blocking c.handler (let ret = Mutex_utils.mutexify c.mutex (fun () -> c.state) () in Duppy.Monad.return ret) in @@ -521,7 +521,7 @@ class output p = || auth_function <> None then ( let default_user = Option.value default_user ~default:"" in - Duppy.Monad.Io.exec ~priority:`Generic handler + Duppy.Monad.Io.exec ~priority:`Maybe_blocking handler (Harbor.http_auth_check ~query ~login:(default_user, login) s headers)) else Duppy.Monad.return ()) @@ -532,7 +532,7 @@ class output p = Harbor.reply s | _ -> assert false) in - Duppy.Monad.Io.exec ~priority:`Generic handler + Duppy.Monad.Io.exec ~priority:`Maybe_blocking handler (Harbor.relayed reply (fun () -> self#log#info "Client %s connected" ip; Mutex_utils.mutexify clients_m diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml index 4f16c3d1c0..00a29985d8 100644 --- a/src/core/sources/request_dynamic.ml +++ b/src/core/sources/request_dynamic.ml @@ -26,6 +26,9 @@ module Queue = Liquidsoap_lang.Queues.Queue let conf_prefetch = Dtools.Conf.int ~p:(Request.conf#plug "prefetch") ~d:1 "Default prefetch" +(* Scheduler priority for request resolutions. *) +let priority = `Maybe_blocking + type queue_item = { request : Request.t; (* in seconds *) @@ -55,8 +58,8 @@ let () = Lifecycle.before_core_shutdown ~name:"request.dynamic shutdown" (fun () -> Atomic.set should_fail true) -class dynamic ?(name = "request.dynamic") ~priority ~retry_delay ~available - ~prefetch ~synchronous ~timeout f = +class dynamic ?(name = "request.dynamic") ~retry_delay ~available ~prefetch + ~synchronous ~timeout f = let available () = (not (Atomic.get should_fail)) && available () in object (self) inherit source ~name () @@ -346,10 +349,6 @@ let _ = ~descr:"Play request dynamically created by a given function." [ ("", Lang.fun_t [] (Lang.nullable_t Request.Value.t), None, None); - ( "thread_queue", - Lang.string_t, - Some (Lang.string "generic"), - Some "Queue used to resolve requests." ); ( "retry_delay", Lang.getter_t Lang.float_t, Some (Lang.float 0.1), @@ -447,12 +446,6 @@ let _ = let f = List.assoc "" p in let available = Lang.to_bool_getter (List.assoc "available" p) in let retry_delay = Lang.to_float_getter (List.assoc "retry_delay" p) in - let priority = - match Lang.to_string (List.assoc "thread_queue" p) with - | "generic" -> `Generic - | "non_blocking" -> `Non_blocking - | n -> `Named n - in let prefetch = Lang.to_valued_option Lang.to_int (List.assoc "prefetch" p) in @@ -461,5 +454,4 @@ let _ = let timeout = Lang.to_valued_option Lang.to_float (List.assoc "timeout" p) in - new dynamic - ~available ~priority ~retry_delay ~prefetch ~timeout ~synchronous f) + new dynamic ~available ~retry_delay ~prefetch ~timeout ~synchronous f) diff --git a/src/core/tools/external_input.ml b/src/core/tools/external_input.ml index e4a6c155bb..4df1a70239 100644 --- a/src/core/tools/external_input.ml +++ b/src/core/tools/external_input.ml @@ -67,7 +67,7 @@ class virtual base ~name ~restart ~restart_on_error ~on_data ?read_header let log s = self#log#important "%s" s in process <- Some - (Process_handler.run ~priority:`Generic ~on_stop ~on_stdout + (Process_handler.run ~priority:`Blocking ~on_stop ~on_stdout ~on_stderr ~log (command ()))); self#on_sleep (fun () -> diff --git a/src/core/tools/liqfm.ml b/src/core/tools/liqfm.ml index 8882fb1b3b..d4c0eeddad 100644 --- a/src/core/tools/liqfm.ml +++ b/src/core/tools/liqfm.ml @@ -231,7 +231,7 @@ let init host = reason (Printexc.to_string e); -1. in - let task = Duppy.Async.add ~priority:`Generic Tutils.scheduler do_submit in + let task = Duppy.Async.add ~priority:`Blocking Tutils.scheduler do_submit in { task; submit_m; submissions } let submit (user, password) task length source stype songs = diff --git a/src/core/tools/server.ml b/src/core/tools/server.ml index d35bc5474e..16350b55ed 100644 --- a/src/core/tools/server.ml +++ b/src/core/tools/server.ml @@ -319,7 +319,7 @@ let handle_client socket ip = | e -> Duppy.Monad.raise e in let* ans = - Duppy.Monad.Io.exec ~priority:`Generic h (run (fun () -> exec req)) + Duppy.Monad.Io.exec ~priority:`Maybe_blocking h (run (fun () -> exec req)) in let* () = let* () = diff --git a/src/core/tools/tutils.ml b/src/core/tools/tutils.ml index b7faea6678..666dd14406 100644 --- a/src/core/tools/tutils.ml +++ b/src/core/tools/tutils.ml @@ -20,9 +20,6 @@ *****************************************************************************) -module Methods = Liquidsoap_lang.Methods -module Lang = Liquidsoap_lang.Lang - let conf_scheduler = Dtools.Conf.void ~p:(Configure.conf#plug "scheduler") @@ -71,6 +68,43 @@ let exit () = | `Done (`Error (bt, err)) -> Printexc.raise_with_backtrace err bt | _ -> exit (exit_code ()) +let generic_queues = + Dtools.Conf.int + ~p:(conf_scheduler#plug "generic_queues") + ~d:5 "Generic queues" + ~comments: + [ + "Number of event queues accepting any kind of task."; + "There should at least be one. Having more can be useful to make sure"; + "that trivial request resolutions (local files) are not delayed"; + "because of a stalled download. But N stalled download can block"; + "N queues anyway."; + ] + +let fast_queues = + Dtools.Conf.int + ~p:(conf_scheduler#plug "fast_queues") + ~d:0 "Fast queues" + ~comments: + [ + "Number of queues that are dedicated to fast tasks."; + "It might be useful to create some if your request resolutions,"; + "or some user defined tasks (cf `thread.run`), are"; + "delayed too much because of slow tasks blocking the generic queues,"; + "such as last.fm submissions or slow `thread.run` handlers."; + ] + +let non_blocking_queues = + Dtools.Conf.int + ~p:(conf_scheduler#plug "non_blocking_queues") + ~d:2 "Non-blocking queues" + ~comments: + [ + "Number of queues dedicated to internal non-blocking tasks."; + "These are only started if such tasks are needed."; + "There should be at least one."; + ] + let scheduler_log = Dtools.Conf.bool ~p:(conf_scheduler#plug "log") @@ -99,26 +133,6 @@ end) let all = ref Set.empty let queues = ref Set.empty -let queues_conf_ref = Atomic.make [("generic", 2); ("non_blocking", 2)] - -let queues_conf = - Lang.reference - (fun () -> - let v = Atomic.get queues_conf_ref in - Lang.list - (List.map - (fun (lbl, c) -> Lang.product (Lang.string lbl) (Lang.int c)) - v)) - (fun v -> - let v = Lang.to_list v in - let v = - List.map - (fun v -> - let lbl, c = Lang.to_product v in - (Lang.to_string lbl, Lang.to_int c)) - v - in - Atomic.set queues_conf_ref v) let join_all ~set () = let rec f () = @@ -212,8 +226,8 @@ let create ~queue f x s = () type priority = - [ `Generic (** Generic queues accept all tasks. *) - | `Named of string (** Named queues only accept tasks with their priority. *) + [ `Blocking (** For example a last.fm submission. *) + | `Maybe_blocking (** Request resolutions vary a lot. *) | `Non_blocking (** Non-blocking tasks like the server. *) ] let error_handlers = Stack.create () @@ -252,14 +266,13 @@ let scheduler_log n = fun m -> log#info "%s" m) else fun _ -> () -let new_queue ~priority ~name () = +let new_queue ?priorities ~name () = let qlog = scheduler_log name in - let priorities p = - match (priority, p) with - | `Generic, (`Generic | `Non_blocking) -> true - | v, v' -> v = v' + let queue () = + match priorities with + | None -> Duppy.queue scheduler ~log:qlog name + | Some priorities -> Duppy.queue scheduler ~log:qlog ~priorities name in - let queue () = Duppy.queue scheduler ~log:qlog ~priorities name in ignore (create ~queue:true queue () name) let create f x name = create ~queue:false f x name @@ -267,27 +280,18 @@ let join_all () = join_all ~set:all () let start () = if Atomic.compare_and_set state `Idle `Starting then ( - let queues = Methods.from_list (Atomic.get queues_conf_ref) in - Methods.iter - (fun priority count -> - let priority = - match priority with - | "generic" -> `Generic - | "non_blocking" -> `Non_blocking - | n -> `Named n - in - for i = 1 to count do - let name = - Printf.sprintf "%s queue #%d" - (match priority with - | `Generic -> "generic" - | `Named n -> n - | `Non_blocking -> "non-blocking") - i - in - new_queue ~priority ~name () - done) - queues) + for i = 1 to generic_queues#get do + let name = Printf.sprintf "generic queue #%d" i in + new_queue ~name () + done; + for i = 1 to fast_queues#get do + let name = Printf.sprintf "fast queue #%d" i in + new_queue ~name ~priorities:(fun x -> x = `Maybe_blocking) () + done; + for i = 1 to non_blocking_queues#get do + let name = Printf.sprintf "non-blocking queue #%d" i in + new_queue ~priorities:(fun x -> x = `Non_blocking) ~name () + done) (** Waits for [f()] to become true on condition [c]. *) let wait c m f = diff --git a/src/core/tools/tutils.mli b/src/core/tools/tutils.mli index 2059b28777..c9d91f9e49 100644 --- a/src/core/tools/tutils.mli +++ b/src/core/tools/tutils.mli @@ -55,13 +55,10 @@ val join_all : unit -> unit (** Priorities for the different scheduler usages. *) type priority = - [ `Generic (** Generic queues accept all tasks. *) - | `Named of string (** Named queues only accept tasks with their priority. *) + [ `Blocking (** For example a last.fm submission. *) + | `Maybe_blocking (** Request resolutions vary a lot. *) | `Non_blocking (** Non-blocking tasks like the server. *) ] -(** Queues configuration. *) -val queues_conf : Liquidsoap_lang.Lang.value - (** task scheduler *) val scheduler : priority Duppy.scheduler diff --git a/src/libs/extra/deprecations.liq b/src/libs/extra/deprecations.liq index 5337a4555c..9ac8638b4d 100644 --- a/src/libs/extra/deprecations.liq +++ b/src/libs/extra/deprecations.liq @@ -76,10 +76,9 @@ end # Deprecated: this function has been replaced by `thread.run.recurrent`. # @flag deprecated -def add_timeout(~fast, delay, f) = +def add_timeout(~fast=true, delay, f) = deprecated("add_timeout", "thread.run.recurrent") - ignore(fast or true) - thread.run.recurrent(queue="generic", delay=delay, f) + thread.run.recurrent(fast=fast, delay=delay, f) end # Deprecated: this function has been replaced by `thread.when`. @@ -315,7 +314,7 @@ def register_flow( ping_period end - thread.run.recurrent(delay=ping_period, ping) + thread.run.recurrent(fast=false, delay=ping_period, ping) # Register streams def register_stream(format_url) = @@ -340,7 +339,7 @@ def register_flow( artist = m["artist"] title = m["title"] params = [("m_title", title), ("m_artist", artist)] - thread.run({request(cmd="metadata", params=params)}) + thread.run(fast=false, {request(cmd="metadata", params=params)}) end s.on_metadata(metadata) diff --git a/src/libs/extra/native.liq b/src/libs/extra/native.liq index a7ead829e5..f8256db410 100644 --- a/src/libs/extra/native.liq +++ b/src/libs/extra/native.liq @@ -171,7 +171,7 @@ def native.request.dynamic(%argsof(request.dynamic), f) = if list.length(queue()) < prefetch then ignore(fetch()) end end - thread.run(queue=thread_queue, every=retry_delay, fill) + thread.run(every=retry_delay, fill) # Source def s() = diff --git a/src/libs/extra/visualization.liq b/src/libs/extra/visualization.liq index 93b441e8d1..20a662ca9b 100644 --- a/src/libs/extra/visualization.liq +++ b/src/libs/extra/visualization.liq @@ -28,7 +28,7 @@ def vumeter(~rms_min=-25., ~rms_max=-5., ~window=0.5, ~scroll=false, s) = print(newline=false, bar()) end - thread.run(queue="non_blocking", every=window, display) + thread.run(fast=true, every=window, display) s end @@ -62,7 +62,7 @@ def video.vumeter( width := int_of_float(x * float_of_int(video.frame.width())) end - thread.run(queue="non_blocking", every=window, update) + thread.run(fast=true, every=window, update) s = video.add_rectangle(width=width, height=height, color=color, s) video.persistence(duration=persistence, s) end diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq index 89251c94c9..8e347453b5 100644 --- a/src/libs/playlist.liq +++ b/src/libs/playlist.liq @@ -173,7 +173,6 @@ let stdlib_native = native # whole round ("randomize" mode), or pick a random file in the playlist each time \ # ("random" mode). # @param ~native Use native implementation, when available. -# @param ~thread_queue Queue used to resolve requests. # @param ~on_loop Function executed when the playlist is about to loop. # @param ~on_done Function executed when the playlist is finished. # @param ~max_fail When this number of requests fail to resolve, the whole playlists is considered as failed and `on_fail` is called. @@ -186,7 +185,6 @@ let stdlib_native = native # @method remaining_files Songs remaining to be played. def playlist.list( ~id=null(), - ~thread_queue="generic", ~check_next=null(), ~prefetch=null(), ~loop=true, @@ -253,7 +251,6 @@ def playlist.list( fun () -> request.dynamic( id=id, - thread_queue=thread_queue, prefetch=prefetch, timeout=timeout, retry_delay=1., @@ -263,13 +260,7 @@ def playlist.list( s = %ifdef native - if - native - then - stdlib_native.request.dynamic(id=id, thread_queue=thread_queue, next) - else - default() - end + if native then stdlib_native.request.dynamic(id=id, next) else default() end %else default() %endif @@ -453,7 +444,6 @@ end # changed). # @param ~register_server_commands Register corresponding server commands # @param ~timeout Timeout (in sec.) to resolve the request. Defaults to `settings.request.timeout` when `null`. -# @param ~thread_queue Queue used to resolve requests. # @param ~cue_in_metadata Metadata for cue in points. Disabled if `null`. # @param ~cue_out_metadata Metadata for cue out points. Disabled if `null`. # @param uri Playlist URI. @@ -462,7 +452,6 @@ end # @method remaining_files Songs remaining to be played. def replaces playlist( ~id=null(), - ~thread_queue="generic", ~check_next=null(), ~prefetch=null(), ~loop=true, @@ -578,7 +567,6 @@ def replaces playlist( s = playlist.list( id=id, - thread_queue=thread_queue, check_next=check_next, prefetch=prefetch, loop=loop, diff --git a/src/libs/request.liq b/src/libs/request.liq index 8ecf2172bf..c27328f3eb 100644 --- a/src/libs/request.liq +++ b/src/libs/request.liq @@ -27,7 +27,6 @@ end # @param ~prefetch How many requests should be queued in advance. # @param ~native Use native implementation, when available. # @param ~queue Initial queue of requests. -# @param ~thread_queue Queue used to resolve requests. # @param ~timeout Timeout (in sec.) to resolve the request. # @method add This method is internal and should not be used. Consider using `push` instead. # @method push Push a request on the request queue. @@ -38,7 +37,6 @@ def request.queue( ~prefetch=null(), ~native=false, ~queue=[], - ~thread_queue="generic", ~timeout=null() ) = ignore(native) @@ -90,7 +88,6 @@ def request.queue( request.dynamic( id=id, prefetch=prefetch, - thread_queue=thread_queue, timeout=timeout, available={not list.is_empty(queue())}, next @@ -101,9 +98,7 @@ def request.queue( if native then - stdlib_native.request.dynamic( - id=id, thread_queue=thread_queue, timeout=timeout, next - ) + stdlib_native.request.dynamic(id=id, timeout=timeout, next) else default() end @@ -218,12 +213,10 @@ end # Play a request once and become unavailable. # @category Source / Input -# @param ~thread_queue Queue used to resolve requests. # @param ~timeout Timeout in seconds for resolving the request. # @param r Request to play. def request.once( ~id=null("request.once"), - ~thread_queue="generic", ~timeout=null(), r ) = @@ -242,7 +235,7 @@ def request.once( if request.resolve(r, timeout=timeout) then - request.queue(thread_queue=thread_queue, queue=[r]) + request.queue(queue=[r]) else log.critical( label=id, @@ -266,7 +259,6 @@ end # static, and time is not. # @category Source / Input # @param ~prefetch How many requests should be queued in advance. -# @param ~thread_queue Queue used to resolve requests. # @param ~timeout Timeout (in sec.) to resolve the request. # @param ~fallible Enforce fallibility of the request. # @param r Request @@ -274,7 +266,6 @@ def request.single( ~id=null("request.single"), ~prefetch=null(), ~timeout=null(), - ~thread_queue="generic", ~fallible=null(), r ) = @@ -358,7 +349,6 @@ def request.single( request.dynamic( id=id, prefetch=prefetch, - thread_queue=thread_queue, synchronous=infallible, next ) diff --git a/src/libs/thread.liq b/src/libs/thread.liq index 45c4dbe699..d623577108 100644 --- a/src/libs/thread.liq +++ b/src/libs/thread.liq @@ -1,15 +1,13 @@ # Run a function in a separate thread. # @category Programming -# @param ~queue Queue to use for the task. Should be one of: `"generic"` or `"non_blocking"`. \ -# Non blocking should be reserved for tasks that are known to complete quickly. \ -# You can also use a dedicated queue name declared via `settings.scheduler.queues`. +# @param ~fast Whether the thread is supposed to return quickly or not. Typically, blocking tasks (e.g. fetching data over the internet) should not be considered to be fast. When set to `false` its priority will be lowered below that of request resolutions and fast timeouts. This is only effective if you set a dedicated queue for fast tasks, see the "scheduler" settings for more details. # @param ~delay Delay (in seconds) after which the thread should be launched. # @param ~every How often (in seconds) the thread should be run. If negative or `null`, run once. # @param ~on_error Error callback executed when an error occurred while running the given function. When passed, \ # all raised errors are silenced unless re-raised by the callback. # @param f Function to execute. def replaces thread.run( - ~queue="generic", + ~fast=true, ~delay=0., ~on_error=null(), ~every=null(), @@ -33,7 +31,7 @@ def replaces thread.run( on_error ) - thread.run.recurrent(queue=queue, delay=delay, on_error=on_error, f) + thread.run.recurrent(fast=fast, delay=delay, on_error=on_error, f) end # Execute a callback when a predicate is `true`. The predicate @@ -41,9 +39,7 @@ end # called when the predicate returns `true` after having been # `false`, following the same semantics as `predicate.activates`. # @category Programming -# @param ~queue Queue to use for the task. Should be one of: `"generic"` or `"non_blocking"`. \ -# Non blocking should be reserved for tasks that are known to complete quickly. \ -# You can also use a dedicated queue name declared via `settings.scheduler.queues`. +# @param ~fast Whether the callback is supposed to return quickly or not. # @param ~init Detect at beginning. # @param ~every How often (in sec.) to check for the predicate. # @param ~once Execute the function only once. @@ -53,7 +49,7 @@ end # @param p Predicate indicating when to execute the function, typically a time interval such as `{10h-10h30}`. # @param f Function to execute when the predicate is true. def thread.when( - ~queue="generic", + ~fast=true, ~init=true, ~every=getter(0.5), ~once=false, @@ -75,7 +71,7 @@ def thread.when( end end - thread.run.recurrent(queue=queue, delay=0., on_error=on_error, check) + thread.run.recurrent(fast=fast, delay=0., on_error=on_error, check) end # @flag hidden diff --git a/tests/language/error.liq b/tests/language/error.liq index 67b11c3c51..76e177412e 100644 --- a/tests/language/error.liq +++ b/tests/language/error.liq @@ -70,7 +70,7 @@ def f() = ) test.equal(r/error.liq, line 58 char 4 - line 63 char 7/.test(pos), true) - test.equal(r/thread.liq, line 21, char 11-14/.test(pos), true) + test.equal(r/thread.liq, line 19, char 11-14/.test(pos), true) e' = error.register("bla") test.equal(false, (e == e')) From 60a2ee1b9f0048784010c11a5c35e65f2012e14a Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 24 Nov 2024 17:15:53 -0600 Subject: [PATCH 107/151] Cleanup logic. --- src/core/builtins/builtins_server.ml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/core/builtins/builtins_server.ml b/src/core/builtins/builtins_server.ml index 32524f8928..0c407cf596 100644 --- a/src/core/builtins/builtins_server.ml +++ b/src/core/builtins/builtins_server.ml @@ -51,10 +51,12 @@ let _ = ] Lang.unit_t (fun p -> - let namespace = - Option.value ~default:"" - (Option.map Lang.to_string - (Lang.to_option (List.assoc "namespace" p))) + let ns = + match + Lang.to_valued_option Lang.to_string (List.assoc "namespace" p) + with + | None -> [] + | Some s -> Re.Pcre.split ~rex:(Re.Pcre.regexp "\\.") s in let descr = Lang.to_string (List.assoc "description" p) in let command = Lang.to_string (Lang.assoc "" 1 p) in @@ -64,6 +66,5 @@ let _ = in let f = Lang.assoc "" 2 p in let f x = Lang.to_string (Lang.apply f [("", Lang.string x)]) in - let ns = Re.Pcre.split ~rex:(Re.Pcre.regexp "\\.") namespace in Server.add ~ns ~usage ~descr command f; Lang.unit) From 1e3d1e6b8a5a07b16fd8c5aa9a295c45acac6120 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 24 Nov 2024 17:18:04 -0600 Subject: [PATCH 108/151] Use String.split_on_char. --- src/core/builtins/builtins_server.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/builtins/builtins_server.ml b/src/core/builtins/builtins_server.ml index 0c407cf596..94ccd91db3 100644 --- a/src/core/builtins/builtins_server.ml +++ b/src/core/builtins/builtins_server.ml @@ -56,7 +56,7 @@ let _ = Lang.to_valued_option Lang.to_string (List.assoc "namespace" p) with | None -> [] - | Some s -> Re.Pcre.split ~rex:(Re.Pcre.regexp "\\.") s + | Some s -> String.split_on_char '.' s in let descr = Lang.to_string (List.assoc "description" p) in let command = Lang.to_string (Lang.assoc "" 1 p) in From 0c50a54ed38f583d23e0f195868fee3e17ec6d8c Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 24 Nov 2024 17:38:18 -0600 Subject: [PATCH 109/151] Use String.trim. Fixes: #4223 --- src/core/tools/server.ml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/core/tools/server.ml b/src/core/tools/server.ml index 16350b55ed..836ae68637 100644 --- a/src/core/tools/server.ml +++ b/src/core/tools/server.ml @@ -237,12 +237,9 @@ let () = add "help" ~usage:"help []" ~descr:"Get information on available commands." (fun args -> try - let args = - Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\s*") - ~subst:(fun _ -> "") - args - in + let args = String.trim args in let _, us, d = Mutex_utils.mutexify lock (Hashtbl.find commands) args in + Printf.printf "Done\n%!"; Printf.sprintf "Usage: %s\r\n %s" us d with Not_found -> (if args <> "" then "No such command: " ^ args ^ "\r\n" else "") From bee3179f35157131d4b3ef9152633b7803dea181 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 24 Nov 2024 17:59:10 -0600 Subject: [PATCH 110/151] Add entry for regexp in migration doc. --- doc/content/migrating.md | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/doc/content/migrating.md b/doc/content/migrating.md index 1bffd2a362..3bfae7fd8f 100644 --- a/doc/content/migrating.md +++ b/doc/content/migrating.md @@ -92,6 +92,35 @@ end However, EBU R128 data is now extracted directly from metadata when available. So `replaygain` cannot control the gain type via this parameter anymore. +### Regular expressions + +The library providing regular expressions has been switched with `2.3.0`. This means that subtle differences +can arise with the evaluation of some regular expressions. + +Here's an example that was recently reported: + +In `2.2.x`, this was true: + +``` +# When using a regular expression with a capture pattern to split, the value matched for splitting is returned: +% string.split(separator="(:|,)", "foo:bar") +["foo", ":", "bar"] + +# But not when using a regular expression without matching: +% string.split(separator=":|,", "foo:bar") +["foo", "bar"] +``` + +In `2.3.x`, the matched pattern is not returned: + +``` +% string.split(separator="(:|,)", "foo:bar") +["foo", "bar"] + +% string.split(separator=":|,", "foo:bar") +["foo", "bar"] +``` + ### Static requests Static requests detection can now work with nested requests. From 377adc5579ad17639bdeb0572c65add098406d33 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 24 Nov 2024 19:32:10 -0600 Subject: [PATCH 111/151] Cleanup regexp usages (#4224) --- src/core/builtins/builtins_files.ml | 9 ++------- src/core/builtins/builtins_sqlite.ml | 4 +--- src/core/operators/frei0r_op.ml | 11 +++-------- src/core/operators/ladspa_op.ml | 4 +--- src/core/outputs/pipe_output.ml | 4 +--- src/core/synth/dssi_op.ml | 4 ++-- src/core/tools/liq_http.ml | 8 ++++---- src/core/tools/sandbox.ml | 2 +- src/core/tools/tutils.ml | 2 +- src/lang/builtins_string.ml | 2 +- src/runtime/main.ml | 2 +- 11 files changed, 18 insertions(+), 34 deletions(-) diff --git a/src/core/builtins/builtins_files.ml b/src/core/builtins/builtins_files.ml index 0466f3247a..5b28bff555 100644 --- a/src/core/builtins/builtins_files.ml +++ b/src/core/builtins/builtins_files.ml @@ -264,13 +264,8 @@ let _ = let pattern = pattern |> Option.map (fun s -> - Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\.") - ~subst:(fun _ -> "\\.") - s) - |> Option.map (fun s -> - Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\*") - ~subst:(fun _ -> ".*") - s) + String.concat "\\." (String.split_on_char '.' s)) + |> Option.map (fun s -> String.concat ".*" (String.split_on_char '*' s)) |> Option.map (fun s -> "^" ^ s ^ "$") |> Option.value ~default:"" in diff --git a/src/core/builtins/builtins_sqlite.ml b/src/core/builtins/builtins_sqlite.ml index 0a659247e4..de73d92933 100644 --- a/src/core/builtins/builtins_sqlite.ml +++ b/src/core/builtins/builtins_sqlite.ml @@ -25,9 +25,7 @@ let error fmt = (fun message -> Runtime_error.raise ~pos:[] ~message "sqlite") fmt -let escape = - let rex = Re.Pcre.regexp "'" in - fun s -> "'" ^ Re.Pcre.substitute ~rex ~subst:(fun _ -> "''") s ^ "'" +let escape s = "'" ^ String.concat "''" (String.split_on_char '\'' s) ^ "'" let insert_value_constr = let open Type in diff --git a/src/core/operators/frei0r_op.ml b/src/core/operators/frei0r_op.ml index 0ace2135a6..e2ec4743d7 100644 --- a/src/core/operators/frei0r_op.ml +++ b/src/core/operators/frei0r_op.ml @@ -39,7 +39,7 @@ let frei0r_enable = let plugin_dirs = try let path = Unix.getenv "LIQ_FREI0R_PATH" in - Re.Pcre.split ~rex:(Re.Pcre.regexp ":") path + String.split_on_char ':' path with Not_found -> Frei0r.default_paths class frei0r_filter ~name bgra instance params (source : source) = @@ -317,9 +317,7 @@ let register_plugin fname = let explanation = let e = info.Frei0r.explanation in let e = String.capitalize_ascii e in - let e = - Re.Pcre.substitute ~rex:(Re.Pcre.regexp "@") ~subst:(fun _ -> "(at)") e - in + let e = String.concat "(at)" (String.split_on_char '@' e) in if e = "" then e else if e.[String.length e - 1] = '.' then String.sub e 0 (String.length e - 1) @@ -327,10 +325,7 @@ let register_plugin fname = in let author = let a = info.Frei0r.author in - let a = - Re.Pcre.substitute ~rex:(Re.Pcre.regexp "@") ~subst:(fun _ -> "(at)") a - in - a + String.concat "(at)" (String.split_on_char '@' a) in let descr = Printf.sprintf "%s (by %s)." explanation author in ignore diff --git a/src/core/operators/ladspa_op.ml b/src/core/operators/ladspa_op.ml index 82b3a79c2f..9f9148537c 100644 --- a/src/core/operators/ladspa_op.ml +++ b/src/core/operators/ladspa_op.ml @@ -365,9 +365,7 @@ let register_descr d = @ if ni = 0 then [] else [("", Lang.source_t input_t, None, None)] in let maker = d.plugin_maker in - let maker = - Re.Pcre.substitute ~rex:(Re.Pcre.regexp "@") ~subst:(fun _ -> "(at)") maker - in + let maker = String.concat "(at)" (String.split_on_char '@' maker) in let descr = Printf.sprintf "%s by %s." d.plugin_name maker in let return_t = if mono then input_t diff --git a/src/core/outputs/pipe_output.ml b/src/core/outputs/pipe_output.ml index e3873f03ba..f0916d535a 100644 --- a/src/core/outputs/pipe_output.ml +++ b/src/core/outputs/pipe_output.ml @@ -445,9 +445,7 @@ class virtual ['a] file_output_base p = let filename = filename () in let filename = Lang_string.home_unrelate filename in (* Avoid / in metas for filename.. *) - let subst m = - Re.Pcre.substitute ~rex:(Re.Pcre.regexp "/") ~subst:(fun _ -> "-") m - in + let subst m = String.concat "-" (String.split_on_char '/' m) in self#interpolate ~subst filename method virtual open_out_gen : open_flag list -> int -> string -> 'a diff --git a/src/core/synth/dssi_op.ml b/src/core/synth/dssi_op.ml index 72f61f00b9..6723cd85a1 100644 --- a/src/core/synth/dssi_op.ml +++ b/src/core/synth/dssi_op.ml @@ -35,13 +35,13 @@ let dssi_enable = let dssi_load = try let venv = Unix.getenv "LIQ_DSSI_LOAD" in - Re.Pcre.split ~rex:(Re.Pcre.regexp ":") venv + String.split_on_char ':' venv with Not_found -> [] let plugin_dirs = try let path = Unix.getenv "LIQ_DSSI_PATH" in - Re.Pcre.split ~rex:(Re.Pcre.regexp ":") path + String.split_on_char ':' path with Not_found -> ["/usr/lib/dssi"; "/usr/local/lib/dssi"] (* Number of channels to synthesize when in all mode *) diff --git a/src/core/tools/liq_http.ml b/src/core/tools/liq_http.ml index 4fa9466c9e..5ca43901f4 100644 --- a/src/core/tools/liq_http.ml +++ b/src/core/tools/liq_http.ml @@ -95,7 +95,7 @@ let user_agent = Configure.vendor let args_split s = let args = Hashtbl.create 2 in let fill_arg arg = - match Re.Pcre.split ~rex:(Re.Pcre.regexp "=") arg with + match String.split_on_char '=' arg with | e :: l -> (* There should be only arg=value *) List.iter @@ -105,7 +105,7 @@ let args_split s = l | [] -> () in - List.iter fill_arg (Re.Pcre.split ~rex:(Re.Pcre.regexp "&") s); + List.iter fill_arg (String.split_on_char '&' s); args let parse_url url = @@ -196,7 +196,7 @@ let really_read ~timeout (socket : socket) len = let read_chunked ~timeout (socket : socket) = let read = read_crlf ~count:1 ~timeout socket in let len = List.hd (Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r]?\n") read) in - let len = List.hd (Re.Pcre.split ~rex:(Re.Pcre.regexp ";") len) in + let len = List.hd (String.split_on_char ':' len) in let len = int_of_string ("0x" ^ len) in let s = really_read socket ~timeout len in ignore (read_crlf ~count:1 ~timeout socket); @@ -210,7 +210,7 @@ let set_socket_default ~read_timeout ~write_timeout fd = type auth = { user : string; password : string } let parse_auth s = - match Re.Pcre.split ~rex:(Re.Pcre.regexp ":") s with + match String.split_on_char ':' s with | user :: (_ :: _ as password) -> { user; password = String.concat ":" password } | _ -> raise Not_found diff --git a/src/core/tools/sandbox.ml b/src/core/tools/sandbox.ml index 4cd30955a4..5616db1560 100644 --- a/src/core/tools/sandbox.ml +++ b/src/core/tools/sandbox.ml @@ -41,7 +41,7 @@ let conf_setenv = let get_setenv () = List.fold_left (fun cur s -> - match Re.Pcre.split ~rex:(Re.Pcre.regexp "=") s with + match String.split_on_char '=' s with | [] -> cur | lbl :: l -> (lbl, String.concat "=" l) :: cur) [] conf_setenv#get diff --git a/src/core/tools/tutils.ml b/src/core/tools/tutils.ml index 666dd14406..33d0c488fe 100644 --- a/src/core/tools/tutils.ml +++ b/src/core/tools/tutils.ml @@ -205,7 +205,7 @@ let create ~queue f x s = (Printexc.to_string e); Printexc.raise_with_backtrace e raw_bt with e -> - let l = Re.Pcre.split ~rex:(Re.Pcre.regexp "\n") bt in + let l = String.split_on_char '\n' bt in List.iter (log#info "%s") l; Mutex_utils.mutexify lock (fun () -> diff --git a/src/lang/builtins_string.ml b/src/lang/builtins_string.ml index 359790a18b..8acfebf15f 100644 --- a/src/lang/builtins_string.ml +++ b/src/lang/builtins_string.ml @@ -465,7 +465,7 @@ let _ = in Lang.string (if space_sensitive then ( - let l = Re.Pcre.split ~rex:(Re.Pcre.regexp " ") string in + let l = String.split_on_char ' ' string in let l = List.map f l in String.concat " " l) else f string)) diff --git a/src/runtime/main.ml b/src/runtime/main.ml index 743b01ca16..7e920221a0 100644 --- a/src/runtime/main.ml +++ b/src/runtime/main.ml @@ -194,7 +194,7 @@ let format_doc s = let prefix = "\t " in let indent = 8 + 2 in let max_width = 80 in - let s = Re.Pcre.split ~rex:(Re.Pcre.regexp " ") s in + let s = String.split_on_char ' ' s in let s = let rec join line width = function | [] -> [line] From 57b317dd11b2c684174ba5574395d10b7fbfcddf Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Mon, 25 Nov 2024 17:37:41 -0600 Subject: [PATCH 112/151] Use new images. (#4226) --- .github/scripts/build-details.sh | 14 ++++---------- .github/scripts/build-docker-alpine.sh | 4 +--- .github/scripts/build-docker.sh | 4 +--- .github/workflows/ci.yml | 18 +++++++++--------- src/core/playlists/playlist_basic.ml | 3 ++- 5 files changed, 17 insertions(+), 26 deletions(-) diff --git a/.github/scripts/build-details.sh b/.github/scripts/build-details.sh index a60af63582..3a172e71ea 100755 --- a/.github/scripts/build-details.sh +++ b/.github/scripts/build-details.sh @@ -21,26 +21,20 @@ if [[ "${IS_FORK}" != "true" && ("${BRANCH}" =~ ^rolling-release\-v[0-9]\.[0-9]\ echo "Branch is release branch" IS_RELEASE=true - echo "Building on all architectures" - BUILD_OS='["debian_trixie", "debian_bookworm", "ubuntu_oracular", "ubuntu_noble", "alpine"]' - BUILD_PLATFORM='["amd64", "arm64"]' - BUILD_INCLUDE='[{"platform": "amd64", "runs-on": "ubuntu-latest", "alpine-arch": "x86_64", "docker-platform": "linux/amd64", "docker-debian-os": "bookworm"}, {"platform": "arm64", "runs-on": ["self-hosted", "build"], "alpine-arch": "aarch64", "docker-platform": "linux/arm64", "docker-debian-os": "bookworm"}]' - echo "Branch has a docker release" DOCKER_RELEASE=true else echo "Branch is not release branch" IS_RELEASE= - echo "Building on amd64 only" - BUILD_OS='["debian_trixie", "debian_bookworm", "ubuntu_oracular", "ubuntu_noble", "alpine"]' - BUILD_PLATFORM='["amd64"]' - BUILD_INCLUDE='[{"platform": "amd64", "runs-on": "ubuntu-latest", "alpine-arch": "x86_64", "docker-platform": "linux/amd64", "docker-debian-os": "bookworm"}]' - echo "Branch does not have a docker release" DOCKER_RELEASE= fi +BUILD_OS='["debian_trixie", "debian_bookworm", "ubuntu_oracular", "ubuntu_noble", "alpine"]' +BUILD_PLATFORM='["amd64", "arm64"]' +BUILD_INCLUDE='[{"platform": "amd64", "runs-on": "ubuntu-latest", "alpine-arch": "x86_64", "docker-debian-os": "bookworm"}, {"platform": "arm64", "runs-on": "depot-ubuntu-22.04-arm-4", "alpine-arch": "aarch64", "docker-debian-os": "bookworm"}]' + SHA=$(git rev-parse --short HEAD) if [[ "${BRANCH}" =~ "rolling-release-" ]]; then diff --git a/.github/scripts/build-docker-alpine.sh b/.github/scripts/build-docker-alpine.sh index cee68aa419..36634ca7f7 100755 --- a/.github/scripts/build-docker-alpine.sh +++ b/.github/scripts/build-docker-alpine.sh @@ -7,15 +7,13 @@ TAG="$2" USER="$3" PASSWORD="$4" ARCHITECTURE="$5" -DOCKER_PLATFORM="$6" cp "$APK_FILE" . docker login -u "$USER" -p "$PASSWORD" -docker buildx build \ +docker build \ --pull \ - --platform "${DOCKER_PLATFORM}" \ --no-cache \ --build-arg "APK_FILE=$APK_FILE" \ --file .github/docker/Dockerfile.production-alpine \ diff --git a/.github/scripts/build-docker.sh b/.github/scripts/build-docker.sh index b461b63dd1..4d26482fcf 100755 --- a/.github/scripts/build-docker.sh +++ b/.github/scripts/build-docker.sh @@ -8,7 +8,6 @@ TAG="$3" USER="$4" PASSWORD="$5" ARCHITECTURE="$6" -DOCKER_PLATFORM="$7" cp "$DEB_FILE" "$DEB_DEBUG_FILE" . @@ -16,9 +15,8 @@ DOCKERFILE=.github/docker/Dockerfile.production docker login -u "$USER" -p "$PASSWORD" -docker buildx build \ +docker build \ --pull \ - --platform "${DOCKER_PLATFORM}" \ --no-cache \ --build-arg "DEB_FILE=$DEB_FILE" \ --build-arg "DEB_DEBUG_FILE=$DEB_DEBUG_FILE" \ diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e1a9714e0d..0495270eea 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -43,7 +43,7 @@ jobs: runs-on: ubuntu-latest needs: build_details container: - image: savonet/liquidsoap-ci:debian_bookworm_amd64 + image: savonet/liquidsoap-ci:debian_bookworm options: --user opam env: HOME: /home/opam @@ -92,7 +92,7 @@ jobs: build_js: runs-on: ubuntu-latest container: - image: savonet/liquidsoap-ci:debian_bookworm_amd64 + image: savonet/liquidsoap-ci:debian_bookworm options: --user opam env: HOME: /home/opam @@ -156,7 +156,7 @@ jobs: needs: build_details if: github.event_name != 'pull_request' && github.repository_owner == 'savonet' && needs.build_details.outputs.branch == 'main' container: - image: savonet/liquidsoap-ci:debian_bookworm_amd64 + image: savonet/liquidsoap-ci:debian_bookworm options: --user root -v ${{ github.workspace }}/${{ github.run_number }}:/tmp/${{ github.run_number }} env: HOME: /home/opam @@ -210,7 +210,7 @@ jobs: runs-on: ubuntu-latest needs: build_details container: - image: savonet/liquidsoap-ci:debian_bookworm_amd64 + image: savonet/liquidsoap-ci:debian_bookworm options: --user root --privileged --ulimit core=-1 --security-opt seccomp=unconfined -v ${{ github.workspace }}/${{ github.run_number }}:/tmp/${{ github.run_number }} strategy: fail-fast: false @@ -369,7 +369,7 @@ jobs: platform: ${{ fromJson(needs.build_details.outputs.build_platform) }} include: ${{ fromJson(needs.build_details.outputs.build_include) }} container: - image: savonet/liquidsoap-ci:${{ matrix.os }}_${{ matrix.platform }} + image: savonet/liquidsoap-ci:${{ matrix.os }} options: --user root --privileged -v ${{ github.workspace }}/${{ github.run_number }}:/tmp/${{ github.run_number }} env: HOME: /home/opam @@ -632,7 +632,7 @@ jobs: - name: Log in to the github registry run: echo "${{ secrets.GITHUB_TOKEN }}" | docker login ghcr.io -u ${{ github.actor }} --password-stdin - name: Build docker image - run: .github/scripts/build-docker.sh ${{ steps.debian_package.outputs.deb-file }} ${{ steps.debian_debug_package.outputs.deb-file }} ${{ needs.build_details.outputs.branch }} ${{ secrets.DOCKERHUB_USER }} ${{ secrets.DOCKERHUB_PASSWORD }} ${{ matrix.platform }} ${{ matrix.docker-platform }} + run: .github/scripts/build-docker.sh ${{ steps.debian_package.outputs.deb-file }} ${{ steps.debian_debug_package.outputs.deb-file }} ${{ needs.build_details.outputs.branch }} ${{ secrets.DOCKERHUB_USER }} ${{ secrets.DOCKERHUB_PASSWORD }} ${{ matrix.platform }} build_docker_alpine: runs-on: ${{ matrix.runs-on }} @@ -659,7 +659,7 @@ jobs: - name: Log in to the github registry run: echo "${{ secrets.GITHUB_TOKEN }}" | docker login ghcr.io -u ${{ github.actor }} --password-stdin - name: Build docker image - run: .github/scripts/build-docker-alpine.sh ${{ steps.alpine_package.outputs.apk-file }} ${{ needs.build_details.outputs.branch }} ${{ secrets.DOCKERHUB_USER }} ${{ secrets.DOCKERHUB_PASSWORD }} ${{ matrix.platform }} ${{ matrix.docker-platform }} + run: .github/scripts/build-docker-alpine.sh ${{ steps.alpine_package.outputs.apk-file }} ${{ needs.build_details.outputs.branch }} ${{ secrets.DOCKERHUB_USER }} ${{ secrets.DOCKERHUB_PASSWORD }} ${{ matrix.platform }} build_docker_minimal: runs-on: ${{ matrix.runs-on }} @@ -690,7 +690,7 @@ jobs: - name: Log in to the github registry run: echo "${{ secrets.GITHUB_TOKEN }}" | docker login ghcr.io -u ${{ github.actor }} --password-stdin - name: Build docker image - run: .github/scripts/build-docker.sh ${{ steps.debian_package.outputs.deb-file }} ${{ steps.debian_debug_package.outputs.deb-file }} ${{ needs.build_details.outputs.branch }}-minimal ${{ secrets.DOCKERHUB_USER }} ${{ secrets.DOCKERHUB_PASSWORD }} ${{ matrix.platform }} ${{ matrix.docker-platform }} + run: .github/scripts/build-docker.sh ${{ steps.debian_package.outputs.deb-file }} ${{ steps.debian_debug_package.outputs.deb-file }} ${{ needs.build_details.outputs.branch }}-minimal ${{ secrets.DOCKERHUB_USER }} ${{ secrets.DOCKERHUB_PASSWORD }} ${{ matrix.platform }} build_docker_alpine_minimal: runs-on: ${{ matrix.runs-on }} @@ -721,7 +721,7 @@ jobs: - name: Log in to the github registry run: echo "${{ secrets.GITHUB_TOKEN }}" | docker login ghcr.io -u ${{ github.actor }} --password-stdin - name: Build docker image - run: .github/scripts/build-docker-alpine.sh ${{ steps.alpine_package.outputs.apk-file }} ${{ steps.alpine_dbg_package.outputs.apk-file }} ${{ needs.build_details.outputs.branch }}-minimal ${{ secrets.DOCKERHUB_USER }} ${{ secrets.DOCKERHUB_PASSWORD }} ${{ matrix.platform }} ${{ matrix.docker-platform }} + run: .github/scripts/build-docker-alpine.sh ${{ steps.alpine_package.outputs.apk-file }} ${{ steps.alpine_dbg_package.outputs.apk-file }} ${{ needs.build_details.outputs.branch }}-minimal ${{ secrets.DOCKERHUB_USER }} ${{ secrets.DOCKERHUB_PASSWORD }} ${{ matrix.platform }} build_docker_release: runs-on: ubuntu-latest diff --git a/src/core/playlists/playlist_basic.ml b/src/core/playlists/playlist_basic.ml index 8a14dc44b9..585e1ec062 100644 --- a/src/core/playlists/playlist_basic.ml +++ b/src/core/playlists/playlist_basic.ml @@ -65,10 +65,11 @@ let parse_extinf s = meta @ match lines with - | [] -> [] + | [] | [""; ""] -> [] | [""; song] -> [("song", String.trim song)] | [artist; title] -> [("artist", String.trim artist); ("title", String.trim title)] + | _ when song = "" -> [] | _ -> [("song", String.trim song)] with Not_found -> [] From c9a99495f837db7d424b2a55b5f94b37be27498d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 26 Nov 2024 00:10:59 -0600 Subject: [PATCH 113/151] Prepare for release. --- CHANGES.md | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5c695618c0..50ca4d2c53 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -# 2.3.0 (unreleased) +# 2.3.0 (2024-11-27) New: @@ -6,8 +6,7 @@ New: should greatly impact impredictable side-effect of the previous models w.r.t. track marks, content sharing and more. This also impacts multiple operators behavior. Mostly, things should be roughly the same with differences around - behaviors related to track marks (`source.on_track` and etc). See @TODO@ for - more details (#3577) + behaviors related to track marks (`source.on_track` and etc). (#3577) - Added script caching layer for faster script startup time. See: https://www.liquidsoap.info/blog/2024-06-13-a-faster-liquidsoap/ for details (#3924, #3949, #3959 and #3977) - Rewrote the clock/streaming loop layer. This prepares our streaming system to support multicore when the OCaml compiler is mature enough to allow it. Clocks @@ -15,7 +14,7 @@ New: down `clock` variable. Users can use the `clock` function to retrieve the full methods, e.g. `s = sine(); c = clock(s.clock)`. This value has advanced functions for clock control such as `start`/`stop`, `ticks` and `self_sync` to check for - `self-sync`. See @TODO@ for more details. (#3781) + `self-sync`. (#3781) - Allow frames duration shorter than one video frames, typically values under `0.04s`. Smaller frames means less latency and memory consumption at the expense of a higher CPU usage (#3607) From 0b2f2816706e2a8b2ab4ea34a95f06668ba002f6 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 26 Nov 2024 08:10:03 -0600 Subject: [PATCH 114/151] Try this. --- .github/scripts/push-docker.sh | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/.github/scripts/push-docker.sh b/.github/scripts/push-docker.sh index 0b6db23351..2c4fa59558 100755 --- a/.github/scripts/push-docker.sh +++ b/.github/scripts/push-docker.sh @@ -17,26 +17,6 @@ COMMIT_SHORT=$(echo "${GITHUB_SHA}" | cut -c-7)$(echo "${GITHUB_SHA}" | cut -d'- docker login -u "$USER" -p "$PASSWORD" -# Something is odd with the docker repo -## REMOVE WHEN FIXED ## -docker login ghcr.io -u "$GHCR_USER" -p "$GHCR_PASSWORD" - -docker pull "ghcr.io/savonet/liquidsoap-ci-build:${TAG}_amd64" -docker tag "ghcr.io/savonet/liquidsoap-ci-build:${TAG}_amd64" "savonet/liquidsoap-ci-build:${TAG}_amd64" -docker push "savonet/liquidsoap-ci-build:${TAG}_amd64" - -docker pull "ghcr.io/savonet/liquidsoap-ci-build:${TAG}_arm64" -docker tag "ghcr.io/savonet/liquidsoap-ci-build:${TAG}_arm64" "savonet/liquidsoap-ci-build:${TAG}_arm64" -docker push "savonet/liquidsoap-ci-build:${TAG}_arm64" - -docker pull "ghcr.io/savonet/liquidsoap-ci-build:${TAG}_alpine_amd64" -docker tag "ghcr.io/savonet/liquidsoap-ci-build:${TAG}_alpine_amd64" "savonet/liquidsoap-ci-build:${TAG}_alpine_amd64" -docker push "savonet/liquidsoap-ci-build:${TAG}_alpine_amd64" - -docker pull "ghcr.io/savonet/liquidsoap-ci-build:${TAG}_alpine_arm64" -docker tag "ghcr.io/savonet/liquidsoap-ci-build:${TAG}_alpine_arm64" "savonet/liquidsoap-ci-build:${TAG}_alpine_arm64" -docker push "savonet/liquidsoap-ci-build:${TAG}_alpine_arm64" - docker manifest create "savonet/liquidsoap:${TAG}" --amend "savonet/liquidsoap-ci-build:${TAG}_amd64" --amend "savonet/liquidsoap-ci-build:${TAG}_arm64" docker manifest push "savonet/liquidsoap:${TAG}" From ed917d5f77eb5e3993c224ed08a757b7be4c5541 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 26 Nov 2024 08:15:39 -0600 Subject: [PATCH 115/151] Add this. --- .github/scripts/build-docker.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/scripts/build-docker.sh b/.github/scripts/build-docker.sh index 4d26482fcf..d1b241a5a7 100755 --- a/.github/scripts/build-docker.sh +++ b/.github/scripts/build-docker.sh @@ -18,6 +18,7 @@ docker login -u "$USER" -p "$PASSWORD" docker build \ --pull \ --no-cache \ + --provenance false \ --build-arg "DEB_FILE=$DEB_FILE" \ --build-arg "DEB_DEBUG_FILE=$DEB_DEBUG_FILE" \ --file "${DOCKERFILE}" \ From 57e6964ea31c0e7dcb3eee8e824dcc9e17a1e97d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 26 Nov 2024 08:47:21 -0600 Subject: [PATCH 116/151] Update README.md --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index 9cc69a5c8c..888e18fb0a 100644 --- a/README.md +++ b/README.md @@ -18,6 +18,8 @@ Copyright 2003-2024 Savonet team [![Chat on Discord!](https://img.shields.io/badge/Chat%20on-Discord-5865f2.svg)](http://chat.liquidsoap.info/) [![](https://img.shields.io/badge/Gurubase-Ask%20Liquidsoap%20Guru-006BFF)](https://gurubase.io/g/liquidsoap) +[![Built with Depot](https://depot.dev/badges/built-with-depot.svg)](https://depot.dev/) + | | | | ------------------------- | ----------------------------------------------------------------------- | | Homepage | http://liquidsoap.info | From 658a6416bfa4cdb915b092a1f0bf98387f89f790 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 26 Nov 2024 08:48:07 -0600 Subject: [PATCH 117/151] Here too. --- .github/scripts/build-docker-alpine.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/scripts/build-docker-alpine.sh b/.github/scripts/build-docker-alpine.sh index 36634ca7f7..9b3888c1e0 100755 --- a/.github/scripts/build-docker-alpine.sh +++ b/.github/scripts/build-docker-alpine.sh @@ -15,6 +15,7 @@ docker login -u "$USER" -p "$PASSWORD" docker build \ --pull \ --no-cache \ + --provenance false \ --build-arg "APK_FILE=$APK_FILE" \ --file .github/docker/Dockerfile.production-alpine \ --tag "savonet/liquidsoap-ci-build:${TAG}_alpine_${ARCHITECTURE}" \ From 070e16a4ac837c19c3af3e10976d5f8e81250d48 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 26 Nov 2024 12:32:35 -0600 Subject: [PATCH 118/151] Add NDI entry. --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index 50ca4d2c53..d532a81fec 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -20,6 +20,7 @@ New: a higher CPU usage (#3607) - Change default frame duration to `0.02s` (#4033) - Optimized runtime (#3927, #3928, #3919) +- Added NDI output support (#4181) - Added `finally` to execute code regardless of whether or not an exception is raised (see: #3895 for more details). - Added support for Spinitron submission API (#4158) From bab3765ad6c708fa9ee55d5169f1a873ea64c18d Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 27 Nov 2024 08:50:57 -0600 Subject: [PATCH 119/151] Add explanation. --- src/js/index.html | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/js/index.html b/src/js/index.html index a42b46a6f7..c68e85ea12 100644 --- a/src/js/index.html +++ b/src/js/index.html @@ -115,6 +115,12 @@ editor = new EditorView({ doc: `# ✨ Welcome to liquidsoap's online interpreter! ✨ # 🤖 Language version: ${version} +# +# ⚠️ This interpreter only supports a small subset of the language ⚠️ +# +# For a most complete exploration of all the operators, we recommend +# using the interactive mode using the `liquidsoap --interactive` CLI. +# # Write your code here: `, From a44e1697ffe538ab13b6f2b4a2f310ce922e4691 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 27 Nov 2024 09:06:08 -0600 Subject: [PATCH 120/151] Update README.md --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 888e18fb0a..995e271793 100644 --- a/README.md +++ b/README.md @@ -39,9 +39,9 @@ See the instructions [here](https://www.liquidsoap.info/doc.html?path=install.ht Current release status by version: | Branch | Latest release | Supported | Rolling Release | | --------|----------------|-----------|-----------------| -| `2.3.x` | | 🧫 (release in RC stage) | [2.3.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.3.x) (docker: [savonet/liquidsoap:rolling-release-v2.3.x](https://hub.docker.com/r/savonet/liquidsoap)) | -| `2.2.x` | [2.2.5](https://github.com/savonet/liquidsoap/releases/tag/v2.2.5) (docker: [savonet/liquidsoap:v2.2.5](https://hub.docker.com/r/savonet/liquidsoap))| 🌅 (release to be retired soon)| [2.2.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.2.x) (docker: [savonet/liquidsoap:rolling-release-v2.2.x](https://hub.docker.com/r/savonet/liquidsoap)) | -| `2.1.x` | [2.1.4](https://github.com/savonet/liquidsoap/releases/tag/v2.1.4) (docker: [savonet/liquidsoap:v2.1.4](https://hub.docker.com/r/savonet/liquidsoap))| ❌ | [2.1.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.1.x) (docker: [savonet/liquidsoap:rolling-release-v2.1.x](https://hub.docker.com/r/savonet/liquidsoap)) | +| `2.3.x` |[2.3.0](https://github.com/savonet/liquidsoap/releases/tag/v2.3.0) (docker: `savonet/liquidsoap:v2.3.0`) | ✅ | [2.3.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.3.x) (docker: `savonet/liquidsoap:rolling-release-v2.3.x` | +| `2.2.x` | [2.2.5](https://github.com/savonet/liquidsoap/releases/tag/v2.2.5) (docker: `savonet/liquidsoap:v2.2.5`) | ❌ | [2.2.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.2.x) (docker: `savonet/liquidsoap:rolling-release-v2.2.x` | +| `2.1.x` | [2.1.4](https://github.com/savonet/liquidsoap/releases/tag/v2.1.4) (docker: `savonet/liquidsoap:v2.1.4`) | ❌ | [2.1.x](https://github.com/savonet/liquidsoap/releases/tag/rolling-release-v2.1.x) (docker: `savonet/liquidsoap:rolling-release-v2.1.x` | ### Versions From 62aedcfa8d31fa9bf2645dbd6977b9bc0e026d8c Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 27 Nov 2024 09:06:35 -0600 Subject: [PATCH 121/151] Fix. --- src/js/index.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/js/index.html b/src/js/index.html index c68e85ea12..d89fd3de07 100644 --- a/src/js/index.html +++ b/src/js/index.html @@ -119,7 +119,7 @@ # ⚠️ This interpreter only supports a small subset of the language ⚠️ # # For a most complete exploration of all the operators, we recommend -# using the interactive mode using the `liquidsoap --interactive` CLI. +# using the interactive mode using the liquidsoap CLI. # # Write your code here: From fcc215c2ac538cf53bed7e62863077f4260f7429 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 29 Nov 2024 09:42:31 -0600 Subject: [PATCH 122/151] Bump menhir. --- dune-project | 2 +- liquidsoap-lang.opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dune-project b/dune-project index eae8305866..588571fb20 100644 --- a/dune-project +++ b/dune-project @@ -155,7 +155,7 @@ (ppx_string :build) (ppx_hash :build) (sedlex (>= 3.2)) - (menhir (>= 20180703)) + (menhir (>= 20240715)) ) (sites (share libs) (share bin) (share cache) (lib_root lib_root)) (synopsis "Liquidsoap language library")) diff --git a/liquidsoap-lang.opam b/liquidsoap-lang.opam index e4dd268d00..f6fbe18cb5 100644 --- a/liquidsoap-lang.opam +++ b/liquidsoap-lang.opam @@ -16,7 +16,7 @@ depends: [ "ppx_string" {build} "ppx_hash" {build} "sedlex" {>= "3.2"} - "menhir" {>= "20180703"} + "menhir" {>= "20240715"} "odoc" {with-doc} ] build: [ From c6e324a5df717d2c69924843f780a1a43555adfa Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 29 Nov 2024 20:57:42 -0600 Subject: [PATCH 123/151] Effect is a keywork on OCaml 5.3. --- src/core/operators/compress.ml | 2 +- src/core/operators/echo.ml | 12 +++---- src/core/operators/video_effects.ml | 50 ++++++++++++++--------------- 3 files changed, 32 insertions(+), 32 deletions(-) diff --git a/src/core/operators/compress.ml b/src/core/operators/compress.ml index e4657052e5..124b888607 100644 --- a/src/core/operators/compress.ml +++ b/src/core/operators/compress.ml @@ -33,7 +33,7 @@ class compress ~attack ~release ~threshold ~ratio ~knee ~track_sensitive let lookahead () = Frame.audio_of_seconds (lookahead ()) in object (self) inherit operator ~name:"compress" [source] - val mutable effect = None + val mutable effect_ = None method fallible = source#fallible method remaining = source#remaining method seek_source = source#seek_source diff --git a/src/core/operators/echo.ml b/src/core/operators/echo.ml index f843a775a4..09859af067 100644 --- a/src/core/operators/echo.ml +++ b/src/core/operators/echo.ml @@ -32,11 +32,11 @@ class echo (source : source) delay feedback ping_pong = method self_sync = source#self_sync method private can_generate_frame = source#is_ready method abort_track = source#abort_track - val mutable effect = None + val mutable effect_ = None initializer self#on_wake_up (fun () -> - effect <- + effect_ <- Some (Audio.Effect.delay self#audio_channels (Lazy.force Frame.audio_rate) @@ -49,10 +49,10 @@ class echo (source : source) delay feedback ping_pong = Content.Audio.get_data (source#get_mutable_content Frame.Fields.audio) in let position = source#frame_audio_position in - let effect = Option.get effect in - effect#set_delay (delay ()); - effect#set_feedback (feedback ()); - effect#process b 0 position; + let effect_ = Option.get effect_ in + effect_#set_delay (delay ()); + effect_#set_feedback (feedback ()); + effect_#process b 0 position; source#set_frame_data Frame.Fields.audio Content.Audio.lift_data b end diff --git a/src/core/operators/video_effects.ml b/src/core/operators/video_effects.ml index e52eed87d6..d690e0d55a 100644 --- a/src/core/operators/video_effects.ml +++ b/src/core/operators/video_effects.ml @@ -25,13 +25,13 @@ open Source let log = Log.make ["video"] -let cached_effect effect = +let cached_effect effect_ = let cache = ref None in fun args -> match !cache with | Some (old_args, result) when old_args = args -> result | _ -> - let result = effect args in + let result = effect_ args in cache := Some (args, result); result @@ -110,18 +110,18 @@ class virtual base ~name (source : source) f = { buf with Content.Video.data } end -class effect ~name (source : source) effect = +class effect_ ~name (source : source) effect_ = object inherit base ~name source - (fun buf off len -> Video.Canvas.iter effect buf off len) + (fun buf off len -> Video.Canvas.iter effect_ buf off len) end -class effect_map ~name (source : source) effect = +class effect_map ~name (source : source) effect_ = object inherit - base ~name source (fun buf off len -> Video.Canvas.map effect buf off len) + base ~name source (fun buf off len -> Video.Canvas.map effect_ buf off len) end let return_t () = @@ -138,7 +138,7 @@ let _ = (fun p -> let f v = List.assoc v p in let src = Lang.to_source (f "") in - new effect ~name:"video.greyscale" src Image.YUV420.Effect.greyscale) + new effect_ ~name:"video.greyscale" src Image.YUV420.Effect.greyscale) let _ = let return_t = return_t () in @@ -148,7 +148,7 @@ let _ = (fun p -> let f v = List.assoc v p in let src = Lang.to_source (f "") in - new effect ~name:"video.sepia" src Image.YUV420.Effect.sepia) + new effect_ ~name:"video.sepia" src Image.YUV420.Effect.sepia) let _ = let return_t = return_t () in @@ -158,7 +158,7 @@ let _ = (fun p -> let f v = List.assoc v p in let src = Lang.to_source (f "") in - new effect ~name:"video.invert" src Image.YUV420.Effect.invert) + new effect_ ~name:"video.invert" src Image.YUV420.Effect.invert) let _ = let return_t = return_t () in @@ -168,7 +168,7 @@ let _ = (fun p -> let f v = List.assoc v p in let src = Lang.to_source (f "") in - new effect ~name:"video.hmirror" src Image.YUV420.hmirror) + new effect_ ~name:"video.hmirror" src Image.YUV420.hmirror) let video_opacity = let return_t = return_t () in @@ -186,7 +186,7 @@ let video_opacity = (fun p -> let a = Lang.to_float_getter (Lang.assoc "" 1 p) in let src = Lang.to_source (Lang.assoc "" 2 p) in - new effect ~name:"video.opacity" src (fun buf -> + new effect_ ~name:"video.opacity" src (fun buf -> Image.YUV420.Effect.Alpha.scale buf (a ()))) let _ = @@ -196,7 +196,7 @@ let _ = ~return_t ~category:`Video ~descr:"Remove α channel." (fun p -> let src = Lang.to_source (List.assoc "" p) in - new effect ~name:"video.alpha.remove" src (fun img -> + new effect_ ~name:"video.alpha.remove" src (fun img -> Image.YUV420.fill_alpha img 0xff)) let _ = @@ -208,7 +208,7 @@ let _ = let f v = List.assoc v p in let c, a = color_arg p in let src = Lang.to_source (f "") in - new effect ~name:"video.fill" src (fun buf -> + new effect_ ~name:"video.fill" src (fun buf -> Image.YUV420.fill buf (c ()); Image.YUV420.fill_alpha buf (a ()))) @@ -228,7 +228,7 @@ let _ = let src = List.assoc "" p |> Lang.to_source in let fps = Lazy.force Frame.video_rate |> float_of_int in let prev = ref (Image.YUV420.create 0 0) in - new effect ~name:"video.persistence" src (fun buf -> + new effect_ ~name:"video.persistence" src (fun buf -> let duration = duration () in if duration > 0. then ( let alpha = 1. -. (1. /. (duration *. fps)) in @@ -262,7 +262,7 @@ let _ = let height = List.assoc "height" p |> Lang.to_int_getter in let c, a = color_arg p in let src = List.assoc "" p |> Lang.to_source in - let effect = + let effect_ = cached_effect (fun (width, height, color, alpha) -> let r = Image.YUV420.create width height in Image.YUV420.fill r color; @@ -276,7 +276,7 @@ let _ = let height = height () in let color = c () in let alpha = a () in - let r = effect (width, height, color, alpha) in + let r = effect_ (width, height, color, alpha) in let r = Video.Canvas.Image.make ~x ~y ~width:(-1) ~height:(-1) r in Video.Canvas.Image.add r buf)) @@ -306,7 +306,7 @@ let _ = in let prec = int_of_float (prec *. 255.) in let color = yuv_of_int color in - new effect ~name:"video.alpha.of_color" src (fun buf -> + new effect_ ~name:"video.alpha.of_color" src (fun buf -> Image.YUV420.alpha_of_color buf color prec)) let _ = @@ -329,7 +329,7 @@ let _ = (* let precision = List.assoc "precision" p |> Lang.to_float in *) let src = List.assoc "" p |> Lang.to_source in let prev = ref None in - new effect ~name:"video.alpha.movement" src (fun img -> + new effect_ ~name:"video.alpha.movement" src (fun img -> (match !prev with | None -> () | Some prev -> Image.YUV420.alpha_of_diff prev img (0xff * 2 / 10) 2); @@ -346,7 +346,7 @@ let () = ~descr:"Blur opacity of video." (fun p -> let src = Lang.to_source (Lang.assoc "" 1 p) in - new effect src Image.YUV420.Effect.Alpha.blur) + new effect_ src Image.YUV420.Effect.Alpha.blur) *) let _ = @@ -357,7 +357,7 @@ let _ = (fun p -> let f v = List.assoc v p in let src = Lang.to_source (f "") in - new effect ~name:"video.lomo" src Image.YUV420.Effect.lomo) + new effect_ ~name:"video.lomo" src Image.YUV420.Effect.lomo) let _ = let return_t = return_t () in @@ -373,7 +373,7 @@ let _ = (fun p -> let a = List.assoc "angle" p |> Lang.to_float_getter in let s = List.assoc "" p |> Lang.to_source in - new effect ~name:"video.rotate" s (fun buf -> + new effect_ ~name:"video.rotate" s (fun buf -> let x = Image.YUV420.width buf / 2 in let y = Image.YUV420.height buf / 2 in Image.YUV420.rotate (Image.YUV420.copy buf) x y (a ()) buf)) @@ -448,7 +448,7 @@ let _ = let ox = Lang.to_int_getter (f "x") in let oy = Lang.to_int_getter (f "y") in let alpha = Lang.to_float_getter (f "alpha") in - new effect ~name:"video.opacity.box" src (fun buf -> + new effect_ ~name:"video.opacity.box" src (fun buf -> Image.YUV420.box_alpha buf (ox ()) (oy ()) (width ()) (height ()) (alpha ()))) @@ -538,14 +538,14 @@ let _ = let q = Lang.assoc "" 2 param |> to_point_getter in let s = Lang.assoc "" 3 param |> Lang.to_source in let c, a = color_arg param in - let effect = + let effect_ = cached_effect (fun (r, g, b, a) -> Video.Canvas.Image.Draw.line (r, g, b, a) (p ()) (q ())) in new effect_map ~name:"video.add_line" s (fun buf -> let r, g, b = c () in let a = a () in - let line = effect (r, g, b, a) in + let line = effect_ (r, g, b, a) in Video.Canvas.Image.add line buf)) let _ = @@ -701,7 +701,7 @@ let _ = to observe the α channel." (fun p -> let s = List.assoc "" p |> Lang.to_source in - new effect ~name:"video.alpha.to_y" s Image.YUV420.alpha_to_y) + new effect_ ~name:"video.alpha.to_y" s Image.YUV420.alpha_to_y) let _ = let return_t = return_t () in From 4e886939fb454e2e2e08ed69699704f425585286 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 29 Nov 2024 22:15:20 -0600 Subject: [PATCH 124/151] Format. --- src/core/operators/video_effects.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/operators/video_effects.ml b/src/core/operators/video_effects.ml index d690e0d55a..651deb5c73 100644 --- a/src/core/operators/video_effects.ml +++ b/src/core/operators/video_effects.ml @@ -121,7 +121,9 @@ class effect_ ~name (source : source) effect_ = class effect_map ~name (source : source) effect_ = object inherit - base ~name source (fun buf off len -> Video.Canvas.map effect_ buf off len) + base + ~name source + (fun buf off len -> Video.Canvas.map effect_ buf off len) end let return_t () = From b08d63c463521a3717ce10aba2e4bd92df6fcd34 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 29 Nov 2024 23:38:41 -0600 Subject: [PATCH 125/151] Try this. --- .github/scripts/build-win32.sh | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/.github/scripts/build-win32.sh b/.github/scripts/build-win32.sh index 1daa3284f6..c89dd7537f 100755 --- a/.github/scripts/build-win32.sh +++ b/.github/scripts/build-win32.sh @@ -42,15 +42,9 @@ export CC="" echo "::group::Installing deps" eval "$(opam config env)" -opam repository set-url default https://github.com/ocaml/opam-repository.git -opam repository set-url windows https://github.com/ocaml-cross/opam-cross-windows.git +cd cd /home/opam/opam-cross-windows +git pull --rebase https://github.com/ocaml-cross/opam-cross-windows.git main opam update windows -# shellcheck disable=SC2046 -opam upgrade -y $(echo "$OPAM_DEPS" | sed -e 's#,# #g') ffmpeg-windows ffmpeg-avutil-windows -opam remove -y pcre-windows - -# Debug -opam reinstall -y cry-windows echo "::endgroup::" From 31612c158423bad3b343d688443fbad87ad1120a Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 29 Nov 2024 23:39:03 -0600 Subject: [PATCH 126/151] Revert "Try this." This reverts commit b08d63c463521a3717ce10aba2e4bd92df6fcd34. --- .github/scripts/build-win32.sh | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/.github/scripts/build-win32.sh b/.github/scripts/build-win32.sh index c89dd7537f..1daa3284f6 100755 --- a/.github/scripts/build-win32.sh +++ b/.github/scripts/build-win32.sh @@ -42,9 +42,15 @@ export CC="" echo "::group::Installing deps" eval "$(opam config env)" -cd cd /home/opam/opam-cross-windows -git pull --rebase https://github.com/ocaml-cross/opam-cross-windows.git main +opam repository set-url default https://github.com/ocaml/opam-repository.git +opam repository set-url windows https://github.com/ocaml-cross/opam-cross-windows.git opam update windows +# shellcheck disable=SC2046 +opam upgrade -y $(echo "$OPAM_DEPS" | sed -e 's#,# #g') ffmpeg-windows ffmpeg-avutil-windows +opam remove -y pcre-windows + +# Debug +opam reinstall -y cry-windows echo "::endgroup::" From d171bfee1c4e635a4b037634e01472719c28537f Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 30 Nov 2024 12:43:01 -0600 Subject: [PATCH 127/151] Switch to new windows build image. (#4234) --- .github/opam/liquidsoap-core-windows.opam | 7 ++++++- .github/scripts/build-win32.sh | 7 ------- .github/workflows/ci.yml | 4 ++-- scripts/dune | 2 +- src/bin/dune | 2 +- src/core/tools/unix_c.c | 1 + 6 files changed, 11 insertions(+), 12 deletions(-) diff --git a/.github/opam/liquidsoap-core-windows.opam b/.github/opam/liquidsoap-core-windows.opam index a75bcc1ddb..ffda9f1e75 100644 --- a/.github/opam/liquidsoap-core-windows.opam +++ b/.github/opam/liquidsoap-core-windows.opam @@ -30,6 +30,11 @@ depends: [ "magic-mime-windows" "menhir" "menhirLib-windows" + "uri" + "uri-windows" + "fileutils" + "fileutils-windows" + "curl-windows" "mem_usage-windows" {>= "0.1.1"} "metadata-windows" {>= "0.3.0"} "dune-site-windows" @@ -123,7 +128,7 @@ build: [ "LIQUIDSOAP_BUILD_TARGET=standalone" "LIQUIDSOAP_SYS_CONFIG=mingw" "LIQUIDSOAP_ENABLE_BUILD_CONFIG=false" - "LDFLAGS=-lssp -lfdk-aac" + "LIQ_LDFLAGS=-lcurl -lwldap32 -ldl -lnghttp2 -lpsl -lssh2 -lidn2 -lzstd -lunistring -lbrotlicommon -lbrotlidec -lcrypt32 -liconv -lpthread -lz -lbcrypt -lwinmm -lksuser -link /usr/src/mxe/usr/x86_64-w64-mingw32.static/lib/libavutil.a" "dune" "build" "-x" diff --git a/.github/scripts/build-win32.sh b/.github/scripts/build-win32.sh index 1daa3284f6..68a6fbd092 100755 --- a/.github/scripts/build-win32.sh +++ b/.github/scripts/build-win32.sh @@ -42,15 +42,8 @@ export CC="" echo "::group::Installing deps" eval "$(opam config env)" -opam repository set-url default https://github.com/ocaml/opam-repository.git opam repository set-url windows https://github.com/ocaml-cross/opam-cross-windows.git opam update windows -# shellcheck disable=SC2046 -opam upgrade -y $(echo "$OPAM_DEPS" | sed -e 's#,# #g') ffmpeg-windows ffmpeg-avutil-windows -opam remove -y pcre-windows - -# Debug -opam reinstall -y cry-windows echo "::endgroup::" diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0495270eea..c37319a3c5 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -482,14 +482,14 @@ jobs: path: ${{ github.workspace }}/${{ github.run_number }}/s3-artifacts build_win32: - runs-on: ubuntu-latest + runs-on: depot-ubuntu-22.04-4 needs: build_details strategy: fail-fast: false matrix: system: [x64] container: - image: savonet/liquidsoap-win32-deps-${{ matrix.system }} + image: savonet/liquidsoap-win32-${{ matrix.system }} options: --user root -v ${{ github.workspace }}/${{ github.run_number }}:/tmp/${{ github.run_number }} env: OPAM_DEPS: ao-windows,lastfm-windows,camomile-windows,cry-windows,dtools-windows,duppy-windows,ffmpeg-windows,ffmpeg-avutil-windows,mm-windows,re-windows,portaudio-windows,samplerate-windows,sedlex-windows,ssl-windows,srt-windows,winsvc-windows,mem_usage-windows diff --git a/scripts/dune b/scripts/dune index b96c64c5e6..01550d6dc8 100644 --- a/scripts/dune +++ b/scripts/dune @@ -1,6 +1,6 @@ (executable (name gen_emacs_completion) - (link_flags -cclib %{env:LDFLAGS=}) + (link_flags -cclib %{env:LIQ_LDFLAGS=}) (libraries liquidsoap_runtime) (modules gen_emacs_completion)) diff --git a/src/bin/dune b/src/bin/dune index f94ad5af4f..667bbe82c1 100644 --- a/src/bin/dune +++ b/src/bin/dune @@ -2,7 +2,7 @@ (name liquidsoap) (public_name liquidsoap) (package liquidsoap-core) - (link_flags -cclib %{env:LDFLAGS=}) + (link_flags -cclib %{env:LIQ_LDFLAGS=}) (libraries liquidsoap_runtime) (modules liquidsoap)) diff --git a/src/core/tools/unix_c.c b/src/core/tools/unix_c.c index 46fe7e0a5c..2f2316a4b8 100644 --- a/src/core/tools/unix_c.c +++ b/src/core/tools/unix_c.c @@ -1,5 +1,6 @@ #ifdef _WIN32 #include +#include #include #else #define _GNU_SOURCE From 442867df66707f22d883bc11624043d61671ea9f Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 4 Dec 2024 09:13:05 -0600 Subject: [PATCH 128/151] Bump version. --- CHANGES.md | 4 ++++ dune-project | 2 +- liquidsoap-core.opam | 2 +- liquidsoap-js.opam | 2 +- liquidsoap-lang.opam | 2 +- liquidsoap-libs-extra.opam | 2 +- liquidsoap-libs.opam | 2 +- liquidsoap-mode.opam | 2 +- liquidsoap.opam | 2 +- 9 files changed, 12 insertions(+), 8 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index d532a81fec..2d9e26721b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +# 2.4.0 (unreleased) + +--- + # 2.3.0 (2024-11-27) New: diff --git a/dune-project b/dune-project index 588571fb20..e4c9f49023 100644 --- a/dune-project +++ b/dune-project @@ -9,7 +9,7 @@ (homepage "https://github.com/savonet/liquidsoap") (bug_reports "https://github.com/savonet/liquidsoap/issues") -(version 2.3.0) +(version 2.4.0) (generate_opam_files true) (executables_implicit_empty_intf true) diff --git a/liquidsoap-core.opam b/liquidsoap-core.opam index 354fa11dd0..af712410b4 100644 --- a/liquidsoap-core.opam +++ b/liquidsoap-core.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.3.0" +version: "2.4.0" synopsis: "Liquidsoap core library and binary" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-js.opam b/liquidsoap-js.opam index 08f5937607..9ad8fe87eb 100644 --- a/liquidsoap-js.opam +++ b/liquidsoap-js.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.3.0" +version: "2.4.0" synopsis: "Liquidsoap language - javascript wrapper" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-lang.opam b/liquidsoap-lang.opam index f6fbe18cb5..a4042b6824 100644 --- a/liquidsoap-lang.opam +++ b/liquidsoap-lang.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.3.0" +version: "2.4.0" synopsis: "Liquidsoap language library" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-libs-extra.opam b/liquidsoap-libs-extra.opam index 6729051038..dbf8c221bb 100644 --- a/liquidsoap-libs-extra.opam +++ b/liquidsoap-libs-extra.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.3.0" +version: "2.4.0" synopsis: "Liquidosap standard library -- extra functionalities" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-libs.opam b/liquidsoap-libs.opam index 424328fce6..2b9470c627 100644 --- a/liquidsoap-libs.opam +++ b/liquidsoap-libs.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.3.0" +version: "2.4.0" synopsis: "Liquidosap standard library" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-mode.opam b/liquidsoap-mode.opam index e69590b43c..9a0d42ad3e 100644 --- a/liquidsoap-mode.opam +++ b/liquidsoap-mode.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.3.0" +version: "2.4.0" synopsis: "Liquidosap emacs mode" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap.opam b/liquidsoap.opam index c27d8ca4d5..050770c6e9 100644 --- a/liquidsoap.opam +++ b/liquidsoap.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.3.0" +version: "2.4.0" synopsis: "Swiss-army knife for multimedia streaming" description: """ Liquidsoap is a powerful and flexible language for describing your From 667446e06b6d567bb00986e41bb5d03d93dcf8a6 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 4 Dec 2024 09:14:28 -0600 Subject: [PATCH 129/151] Minor bump for now. --- liquidsoap-core.opam | 2 +- liquidsoap-js.opam | 2 +- liquidsoap-lang.opam | 2 +- liquidsoap-libs-extra.opam | 2 +- liquidsoap-libs.opam | 2 +- liquidsoap-mode.opam | 2 +- liquidsoap.opam | 6 ++--- src/core/io/alsa_io.ml | 45 +++++++++++++++++++------------------- 8 files changed, 32 insertions(+), 31 deletions(-) diff --git a/liquidsoap-core.opam b/liquidsoap-core.opam index af712410b4..cc9e17915f 100644 --- a/liquidsoap-core.opam +++ b/liquidsoap-core.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.4.0" +version: "2.3.1" synopsis: "Liquidsoap core library and binary" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-js.opam b/liquidsoap-js.opam index 9ad8fe87eb..8df98361a4 100644 --- a/liquidsoap-js.opam +++ b/liquidsoap-js.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.4.0" +version: "2.3.1" synopsis: "Liquidsoap language - javascript wrapper" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-lang.opam b/liquidsoap-lang.opam index a4042b6824..91b7b8979b 100644 --- a/liquidsoap-lang.opam +++ b/liquidsoap-lang.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.4.0" +version: "2.3.1" synopsis: "Liquidsoap language library" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-libs-extra.opam b/liquidsoap-libs-extra.opam index dbf8c221bb..4abde234f6 100644 --- a/liquidsoap-libs-extra.opam +++ b/liquidsoap-libs-extra.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.4.0" +version: "2.3.1" synopsis: "Liquidosap standard library -- extra functionalities" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-libs.opam b/liquidsoap-libs.opam index 2b9470c627..0ab9b54126 100644 --- a/liquidsoap-libs.opam +++ b/liquidsoap-libs.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.4.0" +version: "2.3.1" synopsis: "Liquidosap standard library" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap-mode.opam b/liquidsoap-mode.opam index 9a0d42ad3e..573bf26ca9 100644 --- a/liquidsoap-mode.opam +++ b/liquidsoap-mode.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.4.0" +version: "2.3.1" synopsis: "Liquidosap emacs mode" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/liquidsoap.opam b/liquidsoap.opam index 050770c6e9..f29c300ca2 100644 --- a/liquidsoap.opam +++ b/liquidsoap.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "2.4.0" +version: "2.3.1" synopsis: "Swiss-army knife for multimedia streaming" description: """ Liquidsoap is a powerful and flexible language for describing your @@ -18,8 +18,8 @@ bug-reports: "https://github.com/savonet/liquidsoap/issues" depends: [ "dune" {>= "3.6"} "liquidsoap-core" {= version} - "liquidsoap-libs" {>= "2.3.0" & < "2.3.1"} - "liquidsoap-libs-extra" {>= "2.3.0" & < "2.3.1"} + "liquidsoap-libs" {>= "2.3.1" & < "2.3.2"} + "liquidsoap-libs-extra" {>= "2.3.1" & < "2.3.2"} "pandoc" {with-doc} "pandoc-include" {with-doc} "odoc" {with-doc} diff --git a/src/core/io/alsa_io.ml b/src/core/io/alsa_io.ml index 2a65b9e057..ffbcc50565 100644 --- a/src/core/io/alsa_io.ml +++ b/src/core/io/alsa_io.ml @@ -193,16 +193,12 @@ class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start (float alsa_rate /. float samples_per_second) buf 0 len in - try - let r = ref ofs in - while !r < len do - if !r <> 0 then - self#log#info - "Partial write (%d instead of %d)! Selecting another buffer size \ - or device can help." - !r len; - r := !r + write pcm buf !r (len - !r) - done + let rec pcm_write ofs len = + if 0 < len then ( + let written = write pcm buf ofs len in + pcm_write (ofs + written) (len - written)) + in + try write ofs len with e -> begin match e with @@ -220,7 +216,6 @@ class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start end class input ~self_sync ~start ~on_stop ~on_start ~fallible dev = - let samples_per_frame = AFrame.size () in object (self) inherit base ~self_sync dev [Pcm.Capture] @@ -235,24 +230,30 @@ class input ~self_sync ~start ~on_stop ~on_start ~fallible dev = method abort_track = () method seek_source = (self :> Source.source) method private can_generate_frame = active_source#started + val mutable gen = None + + method generator = + match gen with + | Some g -> g + | None -> + let g = Generator.create self#content_type in + gen <- Some g; + g (* TODO: convert samplerate *) method private generate_frame = let pcm = Option.get pcm in let length = Lazy.force Frame.size in - let frame = Frame.create ~length self#content_type in - let buf = Content.Audio.get_data (Frame.get frame Frame.Fields.audio) in + let gen = self#genetator in try - let r = ref 0 in - while !r < samples_per_frame do - if !r <> 0 then - self#log#info - "Partial read (%d instead of %d)! Selecting another buffer size \ - or device can help." - !r (Audio.length buf); - r := !r + read pcm buf !r (samples_per_frame - !r) + while Generator.length gen < length do + let c = Content.make ~length self#content_type in + let read = + read pcm (Content.Audio.get_data c) 0 (Frame.audio_of_main length) + in + Genetator.put gen Frame.Fields.audio (Content.sub c 0 read) done; - Frame.set_data frame Frame.Fields.audio Content.Audio.lift_data buf + Generator.slice gen length with e -> begin match e with From ba57ecdbcffbc0e92746676d617823d039d6cdd2 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 4 Dec 2024 10:37:13 -0600 Subject: [PATCH 130/151] Add support for WAVE_FORMAT_EXTENSIBLE --- CHANGES.md | 5 +++++ src/core/tools/wav_aiff.ml | 12 ++++++++++-- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 2d9e26721b..bd6d144543 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,10 @@ # 2.4.0 (unreleased) +New: + +- Added support for `WAVE_FORMAT_EXTENSIBLE` to the internal + wav dexcoder. + --- # 2.3.0 (2024-11-27) diff --git a/src/core/tools/wav_aiff.ml b/src/core/tools/wav_aiff.ml index 579d4d7e66..82ce04d8bd 100644 --- a/src/core/tools/wav_aiff.ml +++ b/src/core/tools/wav_aiff.ml @@ -142,8 +142,16 @@ let read_header read_ops ic = if format = `Wav then ( if fmt_len < 0x10 then raise (Not_a_iff_file "Bad header: invalid \"fmt \" length"); - if read_short ic <> 1 then - raise (Not_a_iff_file "Bad header: unhandled codec"); + (match read_short ic with + | 1 + (* Extensible chunk. Should work but might have more than 2 channels and mapping + could be wrong. *) + | 0xfffe -> + () + | c -> + raise + (Not_a_iff_file + (Printf.sprintf "Bad header: unhandled codec 0x%x" c))); let chan_num = read_short ic in let samp_hz = read_int ic in let byt_per_sec = read_int ic in From 33d7cbd3d37cc636cd7da273374058a457a9cb0f Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 4 Dec 2024 11:05:33 -0600 Subject: [PATCH 131/151] Revert this. --- src/core/io/alsa_io.ml | 45 +++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 23 deletions(-) diff --git a/src/core/io/alsa_io.ml b/src/core/io/alsa_io.ml index ffbcc50565..2a65b9e057 100644 --- a/src/core/io/alsa_io.ml +++ b/src/core/io/alsa_io.ml @@ -193,12 +193,16 @@ class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start (float alsa_rate /. float samples_per_second) buf 0 len in - let rec pcm_write ofs len = - if 0 < len then ( - let written = write pcm buf ofs len in - pcm_write (ofs + written) (len - written)) - in - try write ofs len + try + let r = ref ofs in + while !r < len do + if !r <> 0 then + self#log#info + "Partial write (%d instead of %d)! Selecting another buffer size \ + or device can help." + !r len; + r := !r + write pcm buf !r (len - !r) + done with e -> begin match e with @@ -216,6 +220,7 @@ class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start end class input ~self_sync ~start ~on_stop ~on_start ~fallible dev = + let samples_per_frame = AFrame.size () in object (self) inherit base ~self_sync dev [Pcm.Capture] @@ -230,30 +235,24 @@ class input ~self_sync ~start ~on_stop ~on_start ~fallible dev = method abort_track = () method seek_source = (self :> Source.source) method private can_generate_frame = active_source#started - val mutable gen = None - - method generator = - match gen with - | Some g -> g - | None -> - let g = Generator.create self#content_type in - gen <- Some g; - g (* TODO: convert samplerate *) method private generate_frame = let pcm = Option.get pcm in let length = Lazy.force Frame.size in - let gen = self#genetator in + let frame = Frame.create ~length self#content_type in + let buf = Content.Audio.get_data (Frame.get frame Frame.Fields.audio) in try - while Generator.length gen < length do - let c = Content.make ~length self#content_type in - let read = - read pcm (Content.Audio.get_data c) 0 (Frame.audio_of_main length) - in - Genetator.put gen Frame.Fields.audio (Content.sub c 0 read) + let r = ref 0 in + while !r < samples_per_frame do + if !r <> 0 then + self#log#info + "Partial read (%d instead of %d)! Selecting another buffer size \ + or device can help." + !r (Audio.length buf); + r := !r + read pcm buf !r (samples_per_frame - !r) done; - Generator.slice gen length + Frame.set_data frame Frame.Fields.audio Content.Audio.lift_data buf with e -> begin match e with From 578585b7b5edf47b259b1fdbe5f99c98986188da Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 4 Dec 2024 11:07:20 -0600 Subject: [PATCH 132/151] Proper versions --- dune-project | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/dune-project b/dune-project index e4c9f49023..84bfd1e5ea 100644 --- a/dune-project +++ b/dune-project @@ -9,7 +9,7 @@ (homepage "https://github.com/savonet/liquidsoap") (bug_reports "https://github.com/savonet/liquidsoap/issues") -(version 2.4.0) +(version 2.3.1) (generate_opam_files true) (executables_implicit_empty_intf true) @@ -17,8 +17,8 @@ (name liquidsoap) (depends (liquidsoap-core (= :version)) - (liquidsoap-libs (and (>= 2.3.0) (< 2.3.1))) - (liquidsoap-libs-extra (and (>= 2.3.0) (< 2.3.1))) + (liquidsoap-libs (and (>= 2.3.1) (< 2.3.2))) + (liquidsoap-libs-extra (and (>= 2.3.1) (< 2.3.2))) (pandoc :with-doc) (pandoc-include :with-doc)) (synopsis "Swiss-army knife for multimedia streaming") From 853c0fb97c9510ab2ae54542a0eb04aeaee88753 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 5 Dec 2024 09:52:11 -0600 Subject: [PATCH 133/151] Bump mm dep. --- dune-project | 2 +- liquidsoap-core.opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dune-project b/dune-project index 84bfd1e5ea..187428b7b0 100644 --- a/dune-project +++ b/dune-project @@ -49,7 +49,7 @@ (ocaml (>= 4.14)) (dtools (>= 0.4.5)) (duppy (>= 0.9.4)) - (mm (>= 0.8.4)) + (mm (>= 0.8.6)) (re (>= 1.11.0)) (ocurl (>= 0.9.2)) (cry (>= 1.0.3)) diff --git a/liquidsoap-core.opam b/liquidsoap-core.opam index cc9e17915f..9f33a5b40e 100644 --- a/liquidsoap-core.opam +++ b/liquidsoap-core.opam @@ -12,7 +12,7 @@ depends: [ "ocaml" {>= "4.14"} "dtools" {>= "0.4.5"} "duppy" {>= "0.9.4"} - "mm" {>= "0.8.4"} + "mm" {>= "0.8.6"} "re" {>= "1.11.0"} "ocurl" {>= "0.9.2"} "cry" {>= "1.0.3"} From 5bb4088ff4d6c67697623463dbb1a41126e94d15 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 6 Dec 2024 09:26:45 -0600 Subject: [PATCH 134/151] Convert all icy metadata to utf8. --- CHANGES.md | 4 ++++ src/core/io/ffmpeg_io.ml | 1 + 2 files changed, 5 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index bd6d144543..aa7e36609a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,10 @@ New: - Added support for `WAVE_FORMAT_EXTENSIBLE` to the internal wav dexcoder. +Changed: + +- Convert all ICY (icecast) metadata from `input.http` to `utf8`. + --- # 2.3.0 (2024-11-27) diff --git a/src/core/io/ffmpeg_io.ml b/src/core/io/ffmpeg_io.ml index ed2380f936..736b2649a7 100644 --- a/src/core/io/ffmpeg_io.ml +++ b/src/core/io/ffmpeg_io.ml @@ -44,6 +44,7 @@ let normalize_metadata = | "StreamUrl" -> "url" | _ -> lbl in + let v = try Charset.convert ~target:Charset.utf8 v with _ -> v in (lbl, v)) exception Stopped From 96b2de73e8f5c45880bc6afa46961ce1b7dd66e1 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 6 Dec 2024 20:30:07 -0600 Subject: [PATCH 135/151] ALSA fixes (#4242) --- CHANGES.md | 7 +++ src/core/io/alsa_io.ml | 133 ++++++++++++++++++++++++++++------------- 2 files changed, 99 insertions(+), 41 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index aa7e36609a..643b1ba002 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,13 @@ New: - Added support for `WAVE_FORMAT_EXTENSIBLE` to the internal wav dexcoder. +- Added optional `buffer_size` parameter to `input.alsa` and + `output.alsa`. + +Changed: + +- Make alsa I/O work with buffer size different than + liquidsoap internal frame (#4236) Changed: diff --git a/src/core/io/alsa_io.ml b/src/core/io/alsa_io.ml index 2a65b9e057..de0bf7a8f2 100644 --- a/src/core/io/alsa_io.ml +++ b/src/core/io/alsa_io.ml @@ -31,10 +31,10 @@ let handle lbl f x = failwith (Printf.sprintf "Error while setting %s: %s" lbl (string_of_error e)) -class virtual base ~self_sync dev mode = +class virtual base ~buffer_size:buffer_size_seconds ~self_sync dev mode = let samples_per_second = Lazy.force Frame.audio_rate in - let samples_per_frame = AFrame.size () in let periods = Alsa_settings.periods#get in + let buffer_size = Frame.audio_of_seconds buffer_size_seconds in object (self) method virtual log : Log.t method virtual audio_channels : int @@ -42,6 +42,18 @@ class virtual base ~self_sync dev mode = val mutable pcm = None val mutable write = Pcm.writen_float val mutable read = Pcm.readn_float + val mutable alsa_buffer_size = buffer_size + method private alsa_buffer_size = alsa_buffer_size + method virtual content_type : Frame.content_type + val mutable gen = None + + method generator = + match gen with + | Some g -> g + | None -> + let g = Generator.create self#content_type in + gen <- Some g; + g method self_sync : Clock.self_sync = if self_sync then @@ -113,11 +125,10 @@ class virtual base ~self_sync dev mode = let rate = handle "rate" (Pcm.set_rate_near dev params samples_per_second) Dir_eq in - let bufsize = + alsa_buffer_size <- handle "buffer size" (Pcm.set_buffer_size_near dev params) - samples_per_frame - in + (Frame.audio_of_main buffer_size); let periods = if periods > 0 then ( handle "periods" (Pcm.set_periods dev params periods) Dir_eq; @@ -129,12 +140,16 @@ class virtual base ~self_sync dev mode = self#log#important "Could not set sample rate to 'frequency' (%d Hz), got %d." samples_per_second rate; - if bufsize <> samples_per_frame then + if buffer_size <> alsa_buffer_size then self#log#important - "Could not set buffer size to 'frame.size' (%d samples), got %d." - samples_per_frame bufsize; + "Could not set buffer size to: %.02fs (%d samples), got: %.02f (%d \ + samples)." + (Frame.seconds_of_audio buffer_size) + buffer_size + (Frame.seconds_of_audio alsa_buffer_size) + alsa_buffer_size; self#log#important "Samplefreq=%dHz, Bufsize=%dB, Frame=%dB, Periods=%d" - alsa_rate bufsize + alsa_rate alsa_buffer_size (Pcm.get_frame_size params) periods; (try Pcm.set_params dev params @@ -158,8 +173,8 @@ class virtual base ~self_sync dev mode = self#open_device end -class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start - dev val_source = +class output ~buffer_size ~self_sync ~start ~infallible ~register_telnet + ~on_stop ~on_start dev val_source = let samples_per_second = Lazy.force Frame.audio_rate in let name = Printf.sprintf "alsa_out(%s)" dev in object (self) @@ -168,7 +183,7 @@ class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start ~infallible ~register_telnet ~on_stop ~on_start ~name ~output_kind:"output.alsa" val_source start - inherit! base ~self_sync dev [Pcm.Playback] + inherit! base ~buffer_size ~self_sync dev [Pcm.Playback] val mutable samplerate_converter = None method samplerate_converter = @@ -180,11 +195,25 @@ class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start sc method start = self#open_device - method stop = self#close_device + + method stop = + (match (pcm, 0 < Generator.length self#generator) with + | Some _, true -> + self#write_frame + (Generator.slice self#generator (Generator.length self#generator)) + | _ -> ()); + self#close_device method send_frame memo = + let gen = self#generator in + Generator.append gen memo; + let buffer_size = Frame.main_of_audio self#alsa_buffer_size in + if buffer_size <= Generator.length gen then + self#write_frame (Generator.slice gen buffer_size) + + method private write_frame frame = let pcm = Option.get pcm in - let buf = AFrame.pcm memo in + let buf = AFrame.pcm frame in let len = Audio.length buf in let buf, ofs, len = if alsa_rate = samples_per_second then (buf, 0, len) @@ -193,16 +222,12 @@ class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start (float alsa_rate /. float samples_per_second) buf 0 len in - try - let r = ref ofs in - while !r < len do - if !r <> 0 then - self#log#info - "Partial write (%d instead of %d)! Selecting another buffer size \ - or device can help." - !r len; - r := !r + write pcm buf !r (len - !r) - done + let rec pcm_write ofs len = + if 0 < len then ( + let written = write pcm buf ofs len in + pcm_write (ofs + written) (len - written)) + in + try pcm_write ofs len with e -> begin match e with @@ -219,10 +244,9 @@ class output ~self_sync ~start ~infallible ~register_telnet ~on_stop ~on_start else raise e end -class input ~self_sync ~start ~on_stop ~on_start ~fallible dev = - let samples_per_frame = AFrame.size () in +class input ~buffer_size ~self_sync ~start ~on_stop ~on_start ~fallible dev = object (self) - inherit base ~self_sync dev [Pcm.Capture] + inherit base ~buffer_size ~self_sync dev [Pcm.Capture] inherit! Start_stop.active_source @@ -240,19 +264,19 @@ class input ~self_sync ~start ~on_stop ~on_start ~fallible dev = method private generate_frame = let pcm = Option.get pcm in let length = Lazy.force Frame.size in - let frame = Frame.create ~length self#content_type in - let buf = Content.Audio.get_data (Frame.get frame Frame.Fields.audio) in + let alsa_buffer_size = self#alsa_buffer_size in + let gen = self#generator in + let format = Frame.Fields.find Frame.Fields.audio self#content_type in try - let r = ref 0 in - while !r < samples_per_frame do - if !r <> 0 then - self#log#info - "Partial read (%d instead of %d)! Selecting another buffer size \ - or device can help." - !r (Audio.length buf); - r := !r + read pcm buf !r (samples_per_frame - !r) + while Generator.length gen < length do + let c = + Content.make ~length:(Frame.main_of_audio alsa_buffer_size) format + in + let read = read pcm (Content.Audio.get_data c) 0 alsa_buffer_size in + Generator.put gen Frame.Fields.audio + (Content.sub c 0 (Frame.main_of_audio read)) done; - Frame.set_data frame Frame.Fields.audio Content.Audio.lift_data buf + Generator.slice gen length with e -> begin match e with @@ -281,6 +305,12 @@ let _ = Lang.bool_t, Some (Lang.bool true), Some "Mark the source as being synchronized by the ALSA driver." ); + ( "buffer_size", + Lang.nullable_t Lang.float_t, + Some Lang.null, + Some + "ALSA buffer size in seconds. Defaults to frame duration when \ + `null`." ); ( "device", Lang.string_t, Some (Lang.string "default"), @@ -296,6 +326,13 @@ let _ = let source = List.assoc "" p in let infallible = not (Lang.to_bool (List.assoc "fallible" p)) in let register_telnet = Lang.to_bool (List.assoc "register_telnet" p) in + let buffer_size = + match + Lang.to_valued_option Lang.to_float (List.assoc "buffer_size" p) + with + | None -> Lazy.force Frame.duration + | Some v -> v + in let start = Lang.to_bool (List.assoc "start" p) in let on_start = let f = List.assoc "on_start" p in @@ -306,8 +343,8 @@ let _ = fun () -> ignore (Lang.apply f []) in (new output - ~self_sync ~infallible ~register_telnet ~start ~on_start ~on_stop - device source + ~buffer_size ~self_sync ~infallible ~register_telnet ~start ~on_start + ~on_stop device source :> Output.output)) let _ = @@ -322,6 +359,12 @@ let _ = Lang.bool_t, Some (Lang.bool true), Some "Mark the source as being synchronized by the ALSA driver." ); + ( "buffer_size", + Lang.nullable_t Lang.float_t, + Some Lang.null, + Some + "ALSA buffer size in seconds. Defaults to frame duration when \ + `null`." ); ( "device", Lang.string_t, Some (Lang.string "default"), @@ -333,6 +376,13 @@ let _ = let e f v = f (List.assoc v p) in let self_sync = e Lang.to_bool "self_sync" in let device = e Lang.to_string "device" in + let buffer_size = + match + Lang.to_valued_option Lang.to_float (List.assoc "buffer_size" p) + with + | None -> Lazy.force Frame.duration + | Some v -> v + in let start = Lang.to_bool (List.assoc "start" p) in let fallible = Lang.to_bool (List.assoc "fallible" p) in let on_start = @@ -343,5 +393,6 @@ let _ = let f = List.assoc "on_stop" p in fun () -> ignore (Lang.apply f []) in - (new input ~self_sync ~on_start ~on_stop ~fallible ~start device + (new input + ~buffer_size ~self_sync ~on_start ~on_stop ~fallible ~start device :> Start_stop.active_source)) From 47842fb0d3ea76a72ffb78ec48ba091e7da37251 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 7 Dec 2024 09:23:58 -0600 Subject: [PATCH 136/151] Add issue. --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 643b1ba002..6838e609b2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,7 +5,7 @@ New: - Added support for `WAVE_FORMAT_EXTENSIBLE` to the internal wav dexcoder. - Added optional `buffer_size` parameter to `input.alsa` and - `output.alsa`. + `output.alsa` (#4243) Changed: From 7d777edb4dfb0310211b7de2bc96d2b8ded3525e Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 7 Dec 2024 11:40:48 -0600 Subject: [PATCH 137/151] Improve song metadata handling in `input.harbor` (#4244) --- CHANGES.md | 4 ++ src/core/harbor/harbor.ml | 15 ++++--- src/core/harbor/harbor_base.ml | 10 +++++ tests/streams/dune.inc | 62 ++++++++++++++++++++++++++ tests/streams/harbor_metadata.liq | 8 ++-- tests/streams/harbor_metadata_2.liq | 66 +++++++++++++++++++++++++++ tests/streams/harbor_metadata_3.liq | 69 +++++++++++++++++++++++++++++ 7 files changed, 225 insertions(+), 9 deletions(-) create mode 100644 tests/streams/harbor_metadata_2.liq create mode 100644 tests/streams/harbor_metadata_3.liq diff --git a/CHANGES.md b/CHANGES.md index 6838e609b2..82bf43ca19 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,10 @@ Changed: - Make alsa I/O work with buffer size different than liquidsoap internal frame (#4236) +- Make `"song"` metadata mapping to `"title"` metadata in + `input.harbord` disabled when either `"artist"` or `"title"` + is also passed. Add a configuration key to disable this mechanism. + (#4235, #2676) Changed: diff --git a/src/core/harbor/harbor.ml b/src/core/harbor/harbor.ml index ae6df292d8..ca13ef9e4c 100644 --- a/src/core/harbor/harbor.ml +++ b/src/core/harbor/harbor.ml @@ -745,15 +745,18 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct |> Option.map Charset.of_string in (* Recode tags.. *) + let g x = Charset.convert ?source:in_enc x in let f x y m = - let x = + let add, x = match x with - | "song" -> "title" - | "url" -> "metadata_url" - | _ -> x + | "song" when not conf_map_song_metadata#get -> (true, "song") + | "song" -> + ( not (Hashtbl.mem args "title" || Hashtbl.mem args "artist"), + "title" ) + | "url" -> (true, "metadata_url") + | _ -> (true, x) in - let g x = Charset.convert ?source:in_enc x in - Frame.Metadata.add (g x) (g y) m + if add then Frame.Metadata.add (g x) (g y) m else m in let args = Hashtbl.fold f args Frame.Metadata.empty in s#insert_metadata args; diff --git a/src/core/harbor/harbor_base.ml b/src/core/harbor/harbor_base.ml index 69cf492519..e36d901246 100644 --- a/src/core/harbor/harbor_base.ml +++ b/src/core/harbor/harbor_base.ml @@ -63,6 +63,16 @@ let conf_icy_metadata = ] "Content-type (mime) of formats which allow shout metadata update." +let conf_map_song_metadata = + Dtools.Conf.bool + ~p:(conf_harbor#plug "map_song_metadata") + ~d:true + "If `true`, `\"song\"` metadata in icecast metadata update is mapped to \ + `\"title\"` unless on of: `\"artist\"` or `\"title\"` metadata is also \ + passed in which case `\"song\"` metadata is removed as it usually \ + contains redundant info that confuses the system. Metadata are passed \ + as-is when `false`." + let conf_timeout = Dtools.Conf.float ~p:(conf_harbor#plug "timeout") diff --git a/tests/streams/dune.inc b/tests/streams/dune.inc index b8a439556f..655060e424 100644 --- a/tests/streams/dune.inc +++ b/tests/streams/dune.inc @@ -743,6 +743,68 @@ (:run_test ../run_test.exe)) (action (run %{run_test} harbor_metadata.liq liquidsoap %{test_liq} harbor_metadata.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + harbor_metadata_2.liq + ./file1.mp3 + ./file2.mp3 + ./file3.mp3 + ./jingle1.mp3 + ./jingle2.mp3 + ./jingle3.mp3 + ./file1.png + ./file2.png + ./jingles + ./playlist + ./huge_playlist + ./replaygain_track_gain.mp3 + ./r128_track_gain.mp3 + ./replaygain_r128_track_gain.mp3 + ./replaygain_track_gain.opus + ./r128_track_gain.opus + ./replaygain_r128_track_gain.opus + ./without_replaygain_track_gain.mp3 + ./crossfade-plot.old.txt + ./crossfade-plot.new.txt + ../../src/bin/liquidsoap.exe + (package liquidsoap) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} harbor_metadata_2.liq liquidsoap %{test_liq} harbor_metadata_2.liq))) + +(rule + (alias citest) + (package liquidsoap) + (deps + harbor_metadata_3.liq + ./file1.mp3 + ./file2.mp3 + ./file3.mp3 + ./jingle1.mp3 + ./jingle2.mp3 + ./jingle3.mp3 + ./file1.png + ./file2.png + ./jingles + ./playlist + ./huge_playlist + ./replaygain_track_gain.mp3 + ./r128_track_gain.mp3 + ./replaygain_r128_track_gain.mp3 + ./replaygain_track_gain.opus + ./r128_track_gain.opus + ./replaygain_r128_track_gain.opus + ./without_replaygain_track_gain.mp3 + ./crossfade-plot.old.txt + ./crossfade-plot.new.txt + ../../src/bin/liquidsoap.exe + (package liquidsoap) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} harbor_metadata_3.liq liquidsoap %{test_liq} harbor_metadata_3.liq))) + (rule (alias citest) (package liquidsoap) diff --git a/tests/streams/harbor_metadata.liq b/tests/streams/harbor_metadata.liq index 3421f5f6e7..c26ce26dda 100644 --- a/tests/streams/harbor_metadata.liq +++ b/tests/streams/harbor_metadata.liq @@ -1,3 +1,5 @@ +port = 3461 + def fn() = def on_metadata(m) = if @@ -23,7 +25,7 @@ def fn() = password="testtest", user="testtest", host="localhost", - port=9834, + port=port, mount="test", [ ( @@ -46,14 +48,14 @@ def fn() = password="testtest", user="testtest", "test", - port=9834, + port=port, on_connect=on_connect ) s.on_metadata(on_metadata) output.dummy(fallible=true, s) output.icecast( - %mp3, password="testtest", user="testtest", mount="test", port=9834, noise() + %mp3, password="testtest", user="testtest", mount="test", port=port, noise() ) end diff --git a/tests/streams/harbor_metadata_2.liq b/tests/streams/harbor_metadata_2.liq new file mode 100644 index 0000000000..e807496dd2 --- /dev/null +++ b/tests/streams/harbor_metadata_2.liq @@ -0,0 +1,66 @@ +port = 3464 + +def fn() = + def on_metadata(m) = + if + + m["title"] == + "the real title" + + and + + m["metadata_url"] == + "metadata url" + + then + test.pass() + end + end + + def on_connect(_) = + thread.run( + delay=1., + { + icy.update_metadata( + password="testtest", + user="testtest", + host="localhost", + port=port, + mount="test", + [ + ( + "song", + "song title" + ), + ( + "title", + "the real title" + ), + ( + "url", + "metadata url" + ) + ] + ) + } + ) + end + + s = + input.harbor( + buffer=0.1, + password="testtest", + user="testtest", + "test", + port=port, + on_connect=on_connect + ) + + s.on_metadata(on_metadata) + output.dummy(fallible=true, s) + output.icecast( + %mp3, password="testtest", user="testtest", mount="test", port=port, noise() + ) +end + +test.check(fn) diff --git a/tests/streams/harbor_metadata_3.liq b/tests/streams/harbor_metadata_3.liq new file mode 100644 index 0000000000..3f63d28352 --- /dev/null +++ b/tests/streams/harbor_metadata_3.liq @@ -0,0 +1,69 @@ +port = 3463 + +def fn() = + def on_metadata(m) = + print(m) + if + m["title"] == "" + and + + m["artist"] == + "the artist" + + and + + m["metadata_url"] == + "metadata url" + + then + test.pass() + end + end + + def on_connect(_) = + thread.run( + delay=1., + { + icy.update_metadata( + password="testtest", + user="testtest", + host="localhost", + port=port, + mount="test", + [ + ( + "song", + "song title" + ), + ( + "artist", + "the artist" + ), + ( + "url", + "metadata url" + ) + ] + ) + } + ) + end + + s = + input.harbor( + buffer=0.1, + password="testtest", + user="testtest", + "test", + port=port, + on_connect=on_connect + ) + + s.on_metadata(on_metadata) + output.dummy(fallible=true, s) + output.icecast( + %mp3, password="testtest", user="testtest", mount="test", port=port, noise() + ) +end + +test.check(fn) From 6e83321be8779e309413fc59ebd98dcd0e8ed73f Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 8 Dec 2024 09:19:05 -0600 Subject: [PATCH 138/151] Fix mutual recursion between autocue and replaygain metadata resolvers. (#4246) --- CHANGES.md | 4 +++- src/core/builtins/builtins_resolvers.ml | 16 ++++++++++++++++ src/libs/autocue.liq | 8 ++++++-- src/libs/replaygain.liq | 6 ++++-- tests/regression/GH4246.liq | 6 ++++++ tests/regression/dune.inc | 16 ++++++++++++++++ 6 files changed, 51 insertions(+), 5 deletions(-) create mode 100644 tests/regression/GH4246.liq diff --git a/CHANGES.md b/CHANGES.md index 82bf43ca19..06da3084c9 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -16,8 +16,10 @@ Changed: is also passed. Add a configuration key to disable this mechanism. (#4235, #2676) -Changed: +Fixed: +- Fixed request resolution loop when enabling both `autcue` + and `replaygain` metadata resolvers (#4245, fixed in #4246) - Convert all ICY (icecast) metadata from `input.http` to `utf8`. --- diff --git a/src/core/builtins/builtins_resolvers.ml b/src/core/builtins/builtins_resolvers.ml index 03cb1ae20b..72da52303f 100644 --- a/src/core/builtins/builtins_resolvers.ml +++ b/src/core/builtins/builtins_resolvers.ml @@ -21,6 +21,13 @@ *****************************************************************************) let decoder_metadata = Lang.add_module ~base:Modules.decoder "metadata" +let reentrant_decoders = ref [] + +let _ = + Lang.add_builtin ~base:decoder_metadata "reentrant" ~category:`Liquidsoap + ~descr:"Return the list of reentrant decoders." [] + (Lang.list_t Lang.string_t) (fun _ -> + Lang.list (List.map Lang.string !reentrant_decoders)) let _ = let resolver_t = @@ -47,6 +54,13 @@ let _ = Some "Decode files that have the file extensions in this list. Accept any \ file if `null`." ); + ( "reentrant", + Lang.bool_t, + Some (Lang.bool false), + Some + "Set to `true` to indicate that the decoder needs to resolve a \ + request. Such decoders need to be mutually exclusive to avoid \ + request resolution loops!" ); ("", Lang.string_t, None, Some "Format/resolver's name."); ( "", resolver_t, @@ -70,6 +84,7 @@ let _ = (List.assoc "file_extensions" p) in let log = Log.make ["decoder"; "metadata"] in + let reentrant = Lang.to_bool (List.assoc "reentrant" p) in let priority = Lang.to_int_getter (List.assoc "priority" p) in let resolver ~metadata ~extension ~mime fname = if @@ -88,6 +103,7 @@ let _ = in Plug.register Request.mresolvers format ~doc:"" { Request.priority; resolver }; + if reentrant then reentrant_decoders := format :: !reentrant_decoders; Lang.unit) let add_playlist_parser ~format name (parser : Playlist_parser.parser) = diff --git a/src/libs/autocue.liq b/src/libs/autocue.liq index b262242965..592a4ec2a8 100644 --- a/src/libs/autocue.liq +++ b/src/libs/autocue.liq @@ -775,7 +775,7 @@ def autocue.internal.implementation( fade_out_type?: string, fade_out_curve?: float, start_next?: float, - extra_metadata?: [(string * string)] + extra_metadata?: [(string*string)] } ) end @@ -823,7 +823,10 @@ def file.autocue.metadata(~request_metadata, uri) = ) end - r = request.create(excluded_metadata_resolvers=["autocue"], uri) + r = + request.create( + excluded_metadata_resolvers=decoder.metadata.reentrant(), uri + ) if not request.resolve(r) @@ -1059,6 +1062,7 @@ def enable_autocue_metadata() = mime_types=mime_types, file_extensions=file_extensions, priority=settings.autocue.metadata.priority, + reentrant=true, "autocue", autocue_metadata ) diff --git a/src/libs/replaygain.liq b/src/libs/replaygain.liq index 65da5042f7..dd63461351 100644 --- a/src/libs/replaygain.liq +++ b/src/libs/replaygain.liq @@ -76,7 +76,7 @@ def replaces file.replaygain(~id=null(), ~compute=true, ~ratio=50., file_name) = id = string.id.default(default="file.replaygain", id) file_name_quoted = string.quote(file_name) - _metadata = file.metadata(exclude=["replaygain_track_gain"], file_name) + _metadata = file.metadata(exclude=decoder.metadata.reentrant(), file_name) gain = metadata.replaygain(_metadata) if @@ -138,5 +138,7 @@ def enable_replaygain_metadata(~compute=true, ~ratio=50.) = end end - decoder.metadata.add("replaygain_track_gain", replaygain_metadata) + decoder.metadata.add( + reentrant=true, "replaygain_track_gain", replaygain_metadata + ) end diff --git a/tests/regression/GH4246.liq b/tests/regression/GH4246.liq new file mode 100644 index 0000000000..ef5cc6ab33 --- /dev/null +++ b/tests/regression/GH4246.liq @@ -0,0 +1,6 @@ +enable_replaygain_metadata() +enable_autocue_metadata() + +audio = once(single("../media/@shine[channels=2].mp3")) + +output.dummy(fallible=true, on_start=test.pass, audio) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index 25850015bc..8e5e3d264a 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -767,6 +767,22 @@ (:run_test ../run_test.exe)) (action (run %{run_test} GH4163.liq liquidsoap %{test_liq} GH4163.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + GH4246.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} GH4246.liq liquidsoap %{test_liq} GH4246.liq))) + (rule (alias citest) (package liquidsoap) From 6e56d1362b65e077c77ad5fd7be94ce1c8c4761c Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 8 Dec 2024 09:19:31 -0600 Subject: [PATCH 139/151] Fix changes. --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 06da3084c9..4b2badfd66 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -# 2.4.0 (unreleased) +# 2.3.1 (unreleased) New: From 83173fa44bbe921f227e22c925261e5ed5e4a510 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 8 Dec 2024 10:57:59 -0600 Subject: [PATCH 140/151] Fix typo. prevent CI run on non-essential files. --- .github/workflows/ci.yml | 9 +++++++++ CHANGES.md | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c37319a3c5..3282640fb8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -8,6 +8,15 @@ on: - rolling-release-* - v[0-9]+.[0-9]+.[0-9]+ - v[0-9]+.[0-9]+.[0-9]+-* + paths: + - ".github/workflows/ci.yml" + - "**/*.ml" + - "**/*.liq" + - "**/dune" + - "**/dune.inc" + - "doc/**" + - "dune-project" + - scripts/**" concurrency: group: ${{ github.workflow }}-${{ github.ref }} diff --git a/CHANGES.md b/CHANGES.md index 4b2badfd66..75e5a31809 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -18,7 +18,7 @@ Changed: Fixed: -- Fixed request resolution loop when enabling both `autcue` +- Fixed request resolution loop when enabling both `autocue` and `replaygain` metadata resolvers (#4245, fixed in #4246) - Convert all ICY (icecast) metadata from `input.http` to `utf8`. From 0943c078867920336ab9ba2ffe7cb09590d64ef8 Mon Sep 17 00:00:00 2001 From: Martin Kirchgessner Date: Tue, 10 Dec 2024 00:51:11 +0100 Subject: [PATCH 141/151] let go YAML's `not_found` exception (#4249) Co-authored-by: Martin Kirchgessner Co-authored-by: Romain Beauxis --- src/lang/builtins_yaml.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/lang/builtins_yaml.ml b/src/lang/builtins_yaml.ml index 8de7adb421..3a15897b93 100644 --- a/src/lang/builtins_yaml.ml +++ b/src/lang/builtins_yaml.ml @@ -41,6 +41,9 @@ let _ = with exn -> ( let bt = Printexc.get_raw_backtrace () in match exn with + | Runtime_error.Runtime_error e + when e.Runtime_error.kind = "not_found" -> + Printexc.raise_with_backtrace exn bt | _ -> Runtime_error.raise ~bt ~pos:(Lang.pos p) ~message: From 7db3844b879e852d08d5c51241bd6338ec059a32 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 10 Dec 2024 01:07:01 -0600 Subject: [PATCH 142/151] Add string.compare. --- src/lang/builtins_string.ml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/lang/builtins_string.ml b/src/lang/builtins_string.ml index 8acfebf15f..337571ab05 100644 --- a/src/lang/builtins_string.ml +++ b/src/lang/builtins_string.ml @@ -29,6 +29,16 @@ let _ = let s2 = Lang.to_string (Lang.assoc "" 2 p) in Lang.string (s1 ^ s2)) +let _ = + Lang.add_builtin ~base:string "compare" ~category:`String + ~descr:"Compare strings in lexicographical order." + [("", Lang.string_t, None, None); ("", Lang.string_t, None, None)] + Lang.int_t + (fun p -> + let s1 = Lang.to_string (Lang.assoc "" 1 p) in + let s2 = Lang.to_string (Lang.assoc "" 2 p) in + Lang.int (String.compare s1 s2)) + let _ = Lang.add_builtin ~base:string "digest" ~category:`String ~descr:"Return an MD5 digest for the given string." From e7e7207b45a9023df924120e2886c635ab999e07 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Tue, 10 Dec 2024 05:14:06 -0600 Subject: [PATCH 143/151] Add support for type annotations for optional types with methods. (#4251) --- src/lang/parser.mly | 2 ++ tests/language/typing.liq | 3 +++ 2 files changed, 5 insertions(+) diff --git a/src/lang/parser.mly b/src/lang/parser.mly index 520bb222e5..d7401b2966 100644 --- a/src/lang/parser.mly +++ b/src/lang/parser.mly @@ -292,6 +292,8 @@ ty: | LPAR argsty RPAR YIELDS ty { `Arrow ($2,$5) } | LCUR record_ty RCUR { `Record $2 } | ty DOT VAR { `Invoke ($1, $3) } + | ty QUESTION_DOT LCUR record_ty RCUR + { `Method (`Nullable $1, $4) } | ty DOT LCUR record_ty RCUR { `Method ($1, $4) } | ty_source { `Source $1 } diff --git a/tests/language/typing.liq b/tests/language/typing.liq index a467718b4c..cd3dfa217c 100644 --- a/tests/language/typing.liq +++ b/tests/language/typing.liq @@ -209,6 +209,9 @@ def f() = int.{ "✨ name ✨" as foo: float, gni: string } ) + # Nullable type with methods: + (123.{foo="aabb"} : int?.{ foo: string }) + (() : {}) (() : unit.{ }) ({foo=123} : {foo?: int}) From 7d120e13709821832adb9c2e29c426e38f17ce2c Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Wed, 11 Dec 2024 07:43:50 +0100 Subject: [PATCH 144/151] SRT cleanup. --- src/core/io/srt_io.ml | 177 +++++++++++++++++++++------------------- src/core/tools/utils.ml | 2 + 2 files changed, 96 insertions(+), 83 deletions(-) diff --git a/src/core/io/srt_io.ml b/src/core/io/srt_io.ml index 54bc148a30..e3ce1b53c7 100644 --- a/src/core/io/srt_io.ml +++ b/src/core/io/srt_io.ml @@ -368,6 +368,7 @@ module Poll = struct Duppy.Async.wake_up task let remove_socket socket = + Hashtbl.remove t.handlers socket; if List.mem socket (Srt.Poll.sockets t.p) then Srt.Poll.remove_usock t.p socket end @@ -495,28 +496,31 @@ class virtual caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid try Srt.setsockflag s Srt.sndsyn true; Srt.setsockflag s Srt.rcvsyn true; - ignore - (Option.map (fun id -> Srt.(setsockflag s streamid id)) streamid); - ignore - (Option.map - (fun b -> Srt.(setsockflag s enforced_encryption b)) - enforced_encryption); - ignore - (Option.map (fun len -> Srt.(setsockflag s pbkeylen len)) pbkeylen); - ignore - (Option.map (fun p -> Srt.(setsockflag s passphrase p)) passphrase); - ignore - (Option.map - (fun v -> Srt.(setsockflag s conntimeo v)) - connection_timeout); - ignore - (Option.map (fun v -> Srt.(setsockflag s sndtimeo v)) write_timeout); - ignore - (Option.map (fun v -> Srt.(setsockflag s rcvtimeo v)) read_timeout); + Utils.optional_apply + (fun id -> Srt.(setsockflag s streamid id)) + streamid; + Utils.optional_apply + (fun b -> Srt.(setsockflag s enforced_encryption b)) + enforced_encryption; + Utils.optional_apply + (fun len -> Srt.(setsockflag s pbkeylen len)) + pbkeylen; + Utils.optional_apply + (fun p -> Srt.(setsockflag s passphrase p)) + passphrase; + Utils.optional_apply + (fun v -> Srt.(setsockflag s conntimeo v)) + connection_timeout; + Utils.optional_apply + (fun v -> Srt.(setsockflag s sndtimeo v)) + write_timeout; + Utils.optional_apply + (fun v -> Srt.(setsockflag s rcvtimeo v)) + read_timeout; Srt.connect s sockaddr; - Atomic.set socket (Some (sockaddr, s)); self#log#important "Client connected!"; !on_connect (); + Atomic.set socket (Some (sockaddr, s)); -1. with exn -> let bt = Printexc.get_raw_backtrace () in @@ -572,76 +576,83 @@ class virtual listener ~enforced_encryption ~pbkeylen ~passphrase ~max_clients method private listening_socket = match Atomic.get listening_socket with | Some s -> s - | None -> + | None -> ( let s = mk_socket ~payload_size ~messageapi () in - Srt.bind s bind_address; - let max_clients_callback = - Option.map - (fun n _ _ _ _ -> - self#mutexify (fun () -> List.length client_sockets < n) ()) - max_clients - in - let listen_callback = - List.fold_left - (fun cur v -> - match (cur, v) with - | None, _ -> v - | Some _, None -> cur - | Some cur, Some fn -> - Some - (fun s hs_version peeraddr streamid -> - cur s hs_version peeraddr streamid - && fn s hs_version peeraddr streamid)) - None - [max_clients_callback; listen_callback] - in - ignore - (Option.map (fun fn -> Srt.listen_callback s fn) listen_callback); - ignore - (Option.map - (fun b -> Srt.(setsockflag s enforced_encryption b)) - enforced_encryption); - ignore - (Option.map - (fun len -> Srt.(setsockflag s pbkeylen len)) - pbkeylen); - ignore - (Option.map - (fun p -> Srt.(setsockflag s passphrase p)) - passphrase); - Srt.listen s (Option.value ~default:1 max_clients); - self#log#info "Setting up socket to listen at %s" - (string_of_address bind_address); - Atomic.set listening_socket (Some s); - s + try + Srt.bind s bind_address; + let max_clients_callback = + Option.map + (fun n _ _ _ _ -> + self#mutexify (fun () -> List.length client_sockets < n) ()) + max_clients + in + let listen_callback = + List.fold_left + (fun cur v -> + match (cur, v) with + | None, _ -> v + | Some _, None -> cur + | Some cur, Some fn -> + Some + (fun s hs_version peeraddr streamid -> + cur s hs_version peeraddr streamid + && fn s hs_version peeraddr streamid)) + None + [max_clients_callback; listen_callback] + in + Utils.optional_apply + (fun fn -> Srt.listen_callback s fn) + listen_callback; + Utils.optional_apply + (fun b -> Srt.(setsockflag s enforced_encryption b)) + enforced_encryption; + Utils.optional_apply + (fun len -> Srt.(setsockflag s pbkeylen len)) + pbkeylen; + Utils.optional_apply + (fun p -> Srt.(setsockflag s passphrase p)) + passphrase; + Srt.listen s (Option.value ~default:1 max_clients); + self#log#info "Setting up socket to listen at %s" + (string_of_address bind_address); + Atomic.set listening_socket (Some s); + s + with exn -> + let bt = Printexc.get_raw_backtrace () in + Srt.close s; + Printexc.raise_with_backtrace exn bt) method private connect = let rec accept_connection s = try let client, origin = Srt.accept s in - Poll.add_socket ~mode:`Read s accept_connection; - (try self#log#info "New connection from %s" (string_of_address origin) - with exn -> - self#log#important "Error while fetching connection source: %s" - (Printexc.to_string exn)); - Srt.(setsockflag client sndsyn true); - Srt.(setsockflag client rcvsyn true); - ignore - (Option.map - (fun v -> Srt.(setsockflag client sndtimeo v)) - write_timeout); - ignore - (Option.map - (fun v -> Srt.(setsockflag client rcvtimeo v)) - read_timeout); - if self#should_stop then ( - close_socket client; - raise Done); - self#mutexify - (fun () -> - client_sockets <- (origin, client) :: client_sockets; - !on_connect ()) - () + try + Poll.add_socket ~mode:`Read s accept_connection; + (try + self#log#info "New connection from %s" (string_of_address origin) + with exn -> + self#log#important "Error while fetching connection source: %s" + (Printexc.to_string exn)); + Srt.(setsockflag client sndsyn true); + Srt.(setsockflag client rcvsyn true); + Utils.optional_apply + (fun v -> Srt.(setsockflag client sndtimeo v)) + write_timeout; + Utils.optional_apply + (fun v -> Srt.(setsockflag client rcvtimeo v)) + read_timeout; + if self#should_stop then ( + close_socket client; + raise Done); + self#mutexify + (fun () -> + client_sockets <- (origin, client) :: client_sockets; + !on_connect ()) + () + with exn -> + let bt = Printexc.get_raw_backtrace () in + Srt.close client; + Printexc.raise_with_backtrace exn bt with exn -> self#log#debug "Failed to connect: %s" (Printexc.to_string exn) in diff --git a/src/core/tools/utils.ml b/src/core/tools/utils.ml index b341f3b0ca..f78f0450b1 100644 --- a/src/core/tools/utils.ml +++ b/src/core/tools/utils.ml @@ -521,3 +521,5 @@ let is_docker = Lazy.from_fun (fun () -> Sys.unix && Sys.command "grep 'docker\\|lxc' /proc/1/cgroup >/dev/null 2>&1" = 0) + +let optional_apply fn = function None -> () | Some v -> fn v From 5a23638654bffe03b4604e0ccfd65c96749426a5 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Thu, 12 Dec 2024 04:59:34 -0600 Subject: [PATCH 145/151] Add support for native xml parsing. (#4252) --- .github/opam/liquidsoap-core-windows.opam | 1 + .github/scripts/build-posix.sh | 2 + .github/workflows/ci.yml | 2 +- .pre-commit-config.yaml | 2 +- CHANGES.md | 1 + doc/content/xml.md | 160 +++++++++++++++++ doc/dune.inc | 129 ++++++++++++++ dune-project | 1 + liquidsoap-lang.opam | 1 + src/lang/builtins_xml.ml | 204 ++++++++++++++++++++++ src/lang/dune | 2 + src/lang/lexer.ml | 1 + src/lang/parser_helper.ml | 2 + src/lang/parser_helper.mli | 1 + src/lang/term/parsed_term.ml | 1 + src/lang/term/term_preprocessor.ml | 1 + src/lang/term/term_reducer.ml | 12 ++ src/lang/value.ml | 10 +- src/tooling/parsed_json.ml | 1 + tests/language/dune.inc | 12 ++ tests/language/xml_test.liq | 132 ++++++++++++++ 21 files changed, 672 insertions(+), 6 deletions(-) create mode 100644 doc/content/xml.md create mode 100644 src/lang/builtins_xml.ml create mode 100644 tests/language/xml_test.liq diff --git a/.github/opam/liquidsoap-core-windows.opam b/.github/opam/liquidsoap-core-windows.opam index ffda9f1e75..8ae3bcb0a0 100644 --- a/.github/opam/liquidsoap-core-windows.opam +++ b/.github/opam/liquidsoap-core-windows.opam @@ -35,6 +35,7 @@ depends: [ "fileutils" "fileutils-windows" "curl-windows" + "xml-light-windows" "mem_usage-windows" {>= "0.1.1"} "metadata-windows" {>= "0.3.0"} "dune-site-windows" diff --git a/.github/scripts/build-posix.sh b/.github/scripts/build-posix.sh index 21422ac1a9..f48ebf65eb 100755 --- a/.github/scripts/build-posix.sh +++ b/.github/scripts/build-posix.sh @@ -39,6 +39,8 @@ echo "::endgroup::" echo "::group::Setting up specific dependencies" +opam install -y xml-light + cd /tmp/liquidsoap-full/liquidsoap ./.github/scripts/checkout-deps.sh diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 3282640fb8..4e148ace55 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -121,7 +121,7 @@ jobs: cd /tmp/liquidsoap-full/liquidsoap eval "$(opam config env)" opam update - opam install -y saturn_lockfree.0.4.1 + opam install -y xml-light dune build --profile release ./src/js/interactive_js.bc.js tree_sitter_parse: diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 3aa56da0e0..25878f4e98 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -26,7 +26,7 @@ repos: exclude: dune.inc - repo: https://github.com/savonet/pre-commit-liquidsoap - rev: c5eab8dceed09fa985b3cf0ba3fe7f398fc00c04 + rev: 056cf2da9d985e1915a069679f126a461206504a hooks: - id: liquidsoap-prettier diff --git a/CHANGES.md b/CHANGES.md index 75e5a31809..a47e28636c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,7 @@ New: +- Added support for parsing and rendering XML natively (#4252) - Added support for `WAVE_FORMAT_EXTENSIBLE` to the internal wav dexcoder. - Added optional `buffer_size` parameter to `input.alsa` and diff --git a/doc/content/xml.md b/doc/content/xml.md new file mode 100644 index 0000000000..deda87965e --- /dev/null +++ b/doc/content/xml.md @@ -0,0 +1,160 @@ +## Importing/exporting XML values + +Support for XML parsing and rendering was first added in liquidsoap `2.3.1`. + +You can parse XML strings using a decorator and type annotation. There are two different representations of XML you can use. + +### Record access representation + +This is the easiest representation. It is intended for quick access to parsed value via +record and tuples. + +Here's an example: + +```liquidsoap +s = +' + gni + + bla + 1.23 + false + 123 +' + +let xml.parse (x : +{ + bla: { + foo: string.{ xml_params: {opt: float} }, + bar: (unit * string), + blo: float, + blu: bool, + ble: int, + xml_params: { bla: bool } + } +} +) = s + +print("The value for blu is: #{x.bla.ble}") +``` + +Things to note: + +- The basic mappings are: ` -> ` +- Tag content maps tag parameters to a `xml_params` method. +- When multiple tags are present, their values are collected as tuple (`bar` tag in the example) +- When a tag contains a single ground value (`string`, `bool`, `float` or `integer`), the mapping is from tag name to the corresponding value, with xml attributes attached as methods +- Tag parameters can be converted to ground values and omitted. + +The parsing is driven by the type annotation and is intended to be permissive. For instance, this will work: + +```liquidsoaop +s = 'foo' + +# Here, `foo` is omitted. +let xml.parse (x: { bla: unit }) = s + +# x contains: { bla = () } + +# Here, `foo` is made optional +let xml.parse (x: { bla: string? }) = s + +# x contains: { bla = "foo" } +``` + +### Formal representation + +Because XML format can result in complex values, the parser can also use a generic representation. + +Here's an example: + +```liquidsoap +s = +' + gni + + bla + 1.23 + false + 123 +' + +let xml.parse (x : + ( + string + * + { + xml_params: [(string * string)], + xml_children: [ + ( + string + * + { + xml_params: [(string * string)], + xml_children: [(string * {xml_text: string})] + } + ) + ] + } + ) +) = s + +# x contains: +( + "bla", + { + xml_children= + [ + ( + "foo", + { + xml_children=[("xml_text", {xml_text="gni"})], + xml_params=[("opt", "12.3")] + } + ), + ("bar", {xml_children=[], xml_params=[]}), + ( + "bar", + { + xml_children=[("xml_text", {xml_text="bla"})], + xml_params=[("option", "aab")] + } + ), + ( + "blo", + {xml_children=[("xml_text", {xml_text="1.23"})], xml_params=[]} + ), + ( + "blu", + {xml_children=[("xml_text", {xml_text="false"})], xml_params=[]} + ), + ( + "ble", + {xml_children=[("xml_text", {xml_text="123"})], xml_params=[]} + ) + ], + xml_params=[("param", "1"), ("bla", "true")] + } +) +``` + +This representation is much less convenient to manipulate but allows an exact representation of all XML values. + +Things to note: + +- XML nodes are represented by a pair of the form: `(, )` +- `` is a record containing the following methods: + - `xml_params`, represented as a list of pairs `(string * string)` + - `xml_children`, containing a list of the XML node's children. Each entry in the list is a node in the formal XML representation. + - `xml_text`, present when the node is a text node. In this case, `xml_params` and `xm_children` are empty. +- By convention, text nodes are labelled `xml_text` and are of the form: `{ xml_text: "node content" }` + +### Rendering XML values + +XML values can be converted back to strings using `xml.stringify`. + +Both the formal and record-access form can be rendered back into XML strings however, with the record-access representations, if a node has multiple children with the same tag, the conversion to XML string will fail. + +More generally, if the values you want to convert to XML strings are complex, for instance if they use several times the same tag as child node or if the order of child nodes matters, we recommend using the formal representation to make sure that children ordering is properly preserved. + +This is because record methods are not ordered in the language so we make no guarantee that the child nodes they represent be rendered in a specific order. diff --git a/doc/dune.inc b/doc/dune.inc index 0f1f2fdff0..acc89ed9f3 100644 --- a/doc/dune.inc +++ b/doc/dune.inc @@ -9281,6 +9281,134 @@ ) ) +(rule + (alias doc) + (package liquidsoap) + (enabled_if (not %{bin-available:pandoc})) + (deps (:no_pandoc no-pandoc)) + (target xml.html) + (action (run cp %{no_pandoc} %{target})) +) + +(rule + (alias doc) + (package liquidsoap) + (enabled_if %{bin-available:pandoc}) + (deps + liquidsoap.xml + language.dtd + template.html + content/liq/append-silence.liq + content/liq/archive-cleaner.liq + content/liq/basic-radio.liq + content/liq/beets-amplify.liq + content/liq/beets-protocol-short.liq + content/liq/beets-protocol.liq + content/liq/beets-source.liq + content/liq/blank-detect.liq + content/liq/blank-sorry.liq + content/liq/complete-case.liq + content/liq/cross.custom.liq + content/liq/crossfade.liq + content/liq/decoder-faad.liq + content/liq/decoder-flac.liq + content/liq/decoder-metaflac.liq + content/liq/dump-hourly.liq + content/liq/dump-hourly2.liq + content/liq/dynamic-source.liq + content/liq/external-output.file.liq + content/liq/fallback.liq + content/liq/ffmpeg-filter-dynamic-volume.liq + content/liq/ffmpeg-filter-flanger-highpass.liq + content/liq/ffmpeg-filter-hflip.liq + content/liq/ffmpeg-filter-hflip2.liq + content/liq/ffmpeg-filter-parallel-flanger-highpass.liq + content/liq/ffmpeg-live-switch.liq + content/liq/ffmpeg-relay-ondemand.liq + content/liq/ffmpeg-relay.liq + content/liq/ffmpeg-shared-encoding-rtmp.liq + content/liq/ffmpeg-shared-encoding.liq + content/liq/fixed-time1.liq + content/liq/fixed-time2.liq + content/liq/frame-size.liq + content/liq/harbor-auth.liq + content/liq/harbor-dynamic.liq + content/liq/harbor-insert-metadata.liq + content/liq/harbor-metadata.liq + content/liq/harbor-redirect.liq + content/liq/harbor-simple.liq + content/liq/harbor-usage.liq + content/liq/harbor.http.register.liq + content/liq/harbor.http.response.liq + content/liq/hls-metadata.liq + content/liq/hls-mp4.liq + content/liq/http-input.liq + content/liq/icy-update.liq + content/liq/input.mplayer.liq + content/liq/jingle-hour.liq + content/liq/json-ex.liq + content/liq/json-stringify.liq + content/liq/json1.liq + content/liq/live-switch.liq + content/liq/medialib-predicate.liq + content/liq/medialib.liq + content/liq/medialib.sqlite.liq + content/liq/multitrack-add-video-track.liq + content/liq/multitrack-add-video-track2.liq + content/liq/multitrack-default-video-track.liq + content/liq/multitrack.liq + content/liq/multitrack2.liq + content/liq/multitrack3.liq + content/liq/output.file.hls.liq + content/liq/playlists.liq + content/liq/prometheus-callback.liq + content/liq/prometheus-settings.liq + content/liq/radiopi.liq + content/liq/re-encode.liq + content/liq/regular.liq + content/liq/replaygain-metadata.liq + content/liq/replaygain-playlist.liq + content/liq/request.dynamic.liq + content/liq/rtmp.liq + content/liq/samplerate3.liq + content/liq/scheduling.liq + content/liq/seek-telnet.liq + content/liq/settings.liq + content/liq/shoutcast.liq + content/liq/single.liq + content/liq/source-cue.liq + content/liq/space_overhead.liq + content/liq/split-cue.liq + content/liq/sqlite.liq + content/liq/srt-receiver.liq + content/liq/srt-sender.liq + content/liq/switch-show.liq + content/liq/transcoding.liq + content/liq/video-anonymizer.liq + content/liq/video-bluescreen.liq + content/liq/video-canvas-example.liq + content/liq/video-default-canvas.liq + content/liq/video-in-video.liq + content/liq/video-logo.liq + content/liq/video-osc.liq + content/liq/video-simple.liq + content/liq/video-static.liq + content/liq/video-text.liq + content/liq/video-transition.liq + content/liq/video-weather.liq + content/liq/video-webcam.liq + (:md content/xml.md) + ) + (target xml.html) + (action + (pipe-stdout + (run pandoc %{md} -t json) + (run pandoc-include --directory content/liq) + (run pandoc -f json --syntax-definition=liquidsoap.xml --highlight=pygments --metadata pagetitle=xml --template=template.html -o %{target}) + ) + ) +) + (rule (alias doc) (package liquidsoap) @@ -10496,6 +10624,7 @@ (strings_encoding.html as html/strings_encoding.html) (video-static.html as html/video-static.html) (video.html as html/video.html) + (xml.html as html/xml.html) (yaml.html as html/yaml.html) ) ) diff --git a/dune-project b/dune-project index 187428b7b0..b1f1a11f16 100644 --- a/dune-project +++ b/dune-project @@ -156,6 +156,7 @@ (ppx_hash :build) (sedlex (>= 3.2)) (menhir (>= 20240715)) + xml-light ) (sites (share libs) (share bin) (share cache) (lib_root lib_root)) (synopsis "Liquidsoap language library")) diff --git a/liquidsoap-lang.opam b/liquidsoap-lang.opam index 91b7b8979b..afc9905e8e 100644 --- a/liquidsoap-lang.opam +++ b/liquidsoap-lang.opam @@ -17,6 +17,7 @@ depends: [ "ppx_hash" {build} "sedlex" {>= "3.2"} "menhir" {>= "20240715"} + "xml-light" "odoc" {with-doc} ] build: [ diff --git a/src/lang/builtins_xml.ml b/src/lang/builtins_xml.ml new file mode 100644 index 0000000000..c36b883f74 --- /dev/null +++ b/src/lang/builtins_xml.ml @@ -0,0 +1,204 @@ +let rec methods_of_xml = function + | Xml.PCData s -> + ( "xml_text", + Lang.meth (Lang.string s) (xml_node ~text:s ~params:[] ~children:[] ()) + ) + | Xml.Element (name, params, ([Xml.PCData s] as children)) -> + (name, Lang.meth (Lang.string s) (xml_node ~text:s ~params ~children ())) + | Xml.Element (name, params, children) -> + ( name, + Lang.record + (Methods.bindings + (List.fold_left + (fun methods el -> + let name, v = methods_of_xml el in + let v = + match Methods.find_opt name methods with + | None -> v + | Some (Value.Tuple { value = [] } as value) -> + Lang.tuple [value; v] + | Some (Value.Tuple { value }) -> Lang.tuple (value @ [v]) + | Some value -> Lang.tuple [value; v] + in + Methods.add name v methods) + (Methods.from_list (xml_node ~params ~children ())) + children)) ) + +and xml_node ?text ~params ~children () = + [ + ("xml_text", match text with None -> Lang.null | Some s -> Lang.string s); + ( "xml_params", + Lang.meth + (Lang.list + (List.map + (fun (k, v) -> Lang.product (Lang.string k) (Lang.string v)) + params)) + (List.map (fun (k, v) -> (k, Lang.string v)) params) ); + ("xml_children", Lang.list (List.map (fun v -> value_of_xml v) children)); + ] + +and value_of_xml v = + let name, methods = methods_of_xml v in + Lang.meth (Lang.tuple [Lang.string name; methods]) [(name, methods)] + +let rec check_value v ty = + let typ_meths, ty = Type.split_meths ty in + let meths, v = Value.split_meths v in + let v = + match (v, ty.Type.descr) with + | Value.Tuple { value = [] }, Type.Nullable _ -> Lang.null + | _, Type.Tuple [] -> Lang.tuple [] + | Value.Tuple { value }, Type.Tuple l -> + Lang.tuple + (List.mapi (fun idx v -> check_value v (List.nth l idx)) value) + | Value.List { value = l }, Type.List { t = ty } -> + Lang.list (List.map (fun v -> check_value v ty) l) + | Value.String { value = s }, Type.Int -> Lang.int (int_of_string s) + | Value.String { value = s }, Type.Float -> Lang.float (float_of_string s) + | Value.String { value = s }, Type.Bool -> Lang.bool (bool_of_string s) + | Value.String _, Type.Nullable ty -> check_value v ty + | _, Type.Var _ | Value.String _, Type.String -> v + | _ -> assert false + in + let meths = + List.fold_left + (fun checked_meths { Type.meth; scheme = _, ty } -> + let v = List.assoc meth meths in + (meth, check_value v ty) :: checked_meths) + [] typ_meths + in + let v = Lang.meth v meths in + v + +let _ = + Lang.add_builtin "_internal_xml_parser_" ~category:`String ~flags:[`Hidden] + ~descr:"Internal xml parser" + [ + ("type", Value.RuntimeType.t, None, Some "Runtime type"); + ("", Lang.string_t, None, None); + ] + (Lang.univ_t ()) + (fun p -> + let s = Lang.to_string (List.assoc "" p) in + let ty = Value.RuntimeType.of_value (List.assoc "type" p) in + let ty = Type.fresh ty in + try + let xml = Xml.parse_string s in + let value = value_of_xml xml in + check_value value ty + with exn -> ( + let bt = Printexc.get_raw_backtrace () in + match exn with + | _ -> + Runtime_error.raise ~bt ~pos:(Lang.pos p) + ~message: + (Printf.sprintf + "Parse error: xml value cannot be parsed as type: %s" + (Type.to_string ty)) + "xml")) + +let xml = Lang.add_module "xml" + +let string_of_ground v = + match v with + | Value.String { value = s } -> s + | Value.Bool { value = b } -> string_of_bool b + | Value.Float { value = f } -> Utils.string_of_float f + | Value.Int { value = i; flags } -> Value.string_of_int_value ~flags i + | _ -> assert false + +let params_of_xml_params v = + match Lang.split_meths v with + | [], Value.List { value = params } -> + List.map + (function + | Value.Tuple { value = [Value.String { value = s }; v] } -> + (s, string_of_ground v) + | _ -> assert false) + params + | params, Value.Tuple { value = [] } -> + List.map (fun (s, v) -> (s, string_of_ground v)) params + | _ -> assert false + +let params_of_optional_params = function + | None -> [] + | Some params -> params_of_xml_params params + +let rec xml_of_value = function + | Value.Tuple + { + value = + [Value.String { value = name }; Value.Tuple { value = []; methods }]; + } -> + xml_of_node ~name (Methods.bindings methods) + | Value.Tuple { value = []; methods } -> ( + match Methods.bindings methods with + | [(name, Value.Tuple { value = []; methods })] -> + xml_of_node ~name (Methods.bindings methods) + | [(name, (Value.String { methods } as v))] + | [(name, (Value.Float { methods } as v))] + | [(name, (Value.Int { methods } as v))] + | [(name, (Value.Bool { methods } as v))] -> + xml_of_node ~xml_text:(string_of_ground v) ~name + (Methods.bindings methods) + | _ -> assert false) + | _ -> assert false + +and xml_of_node ?xml_text ~name meths = + let xml_text = + match xml_text with + | Some s -> Some s + | None -> Option.map Lang.to_string (List.assoc_opt "xml_text" meths) + in + let xml_children = + Option.map Lang.to_list (List.assoc_opt "xml_children" meths) + in + let xml_params = List.assoc_opt "xml_params" meths in + let meths = + List.filter + (fun (k, _) -> + not (List.mem k ["xml_text"; "xml_children"; "xml_params"])) + meths + in + match (name, xml_params, xml_children, xml_text, meths) with + | "xml_text", None, None, Some s, [] -> Xml.PCData s + | name, xml_params, None, Some s, [] -> + Xml.Element (name, params_of_optional_params xml_params, [Xml.PCData s]) + | name, xml_params, Some nodes, None, [] -> + Xml.Element + ( name, + params_of_optional_params xml_params, + List.map xml_of_value nodes ) + | name, xml_params, None, None, nodes -> + Xml.Element + ( name, + params_of_optional_params xml_params, + List.map + (fun (name, value) -> xml_of_value (Lang.record [(name, value)])) + nodes ) + | _ -> assert false + +let _ = + Lang.add_builtin ~base:xml "stringify" ~category:`String + ~descr: + "Convert a value to XML. If the value cannot be represented as XML (for \ + instance a function), a `error.xml` exception is raised." + [ + ( "compact", + Lang.bool_t, + Some (Lang.bool false), + Some "Output compact text." ); + ("", Lang.univ_t (), None, None); + ] + Lang.string_t + (fun p -> + let v = List.assoc "" p in + let compact = Lang.to_bool (List.assoc "compact" p) in + try + let xml = xml_of_value v in + Lang.string + (if compact then Xml.to_string xml else Xml.to_string_fmt xml) + with _ -> + let bt = Printexc.get_raw_backtrace () in + Runtime_error.raise ~bt ~pos:(Lang.pos p) + ~message:"Value could not be converted to XML!" "xml") diff --git a/src/lang/dune b/src/lang/dune index a9eac7fe13..c8093d6ad3 100644 --- a/src/lang/dune +++ b/src/lang/dune @@ -94,6 +94,7 @@ str unix menhirLib + xml-light (select liqmemtrace.ml from @@ -113,6 +114,7 @@ builtins_regexp builtins_string builtins_yaml + builtins_xml builtins_ref cache doc diff --git a/src/lang/lexer.ml b/src/lang/lexer.ml index 75a1900dce..a8810a7096 100644 --- a/src/lang/lexer.ml +++ b/src/lang/lexer.ml @@ -213,6 +213,7 @@ let rec token lexbuf = | "let", Plus skipped, "yaml.parse", Plus skipped -> LET `Yaml_parse | "let", Plus skipped, "sqlite.row", Plus skipped -> LET `Sqlite_row | "let", Plus skipped, "sqlite.query", Plus skipped -> LET `Sqlite_query + | "let", Plus skipped, "xml.parse", Plus skipped -> LET `Xml_parse | "let" -> LET `None | "fun" -> FUN | '=' -> GETS diff --git a/src/lang/parser_helper.ml b/src/lang/parser_helper.ml index 51dec784c7..14d620efb5 100644 --- a/src/lang/parser_helper.ml +++ b/src/lang/parser_helper.ml @@ -36,6 +36,7 @@ type lexer_let_decoration = | `Eval | `Json_parse | `Yaml_parse + | `Xml_parse | `Sqlite_row | `Sqlite_query ] @@ -185,6 +186,7 @@ type let_opt_el = string * Term.t let let_decoration_of_lexer_let_decoration = function | `Json_parse -> `Json_parse [] | `Yaml_parse -> `Yaml_parse + | `Xml_parse -> `Xml_parse | `Sqlite_query -> `Sqlite_query | `Sqlite_row -> `Sqlite_row | `Eval -> `Eval diff --git a/src/lang/parser_helper.mli b/src/lang/parser_helper.mli index fea009cf66..8178a3428b 100644 --- a/src/lang/parser_helper.mli +++ b/src/lang/parser_helper.mli @@ -35,6 +35,7 @@ type lexer_let_decoration = | `Recursive | `Replaces | `Yaml_parse + | `Xml_parse | `Sqlite_row | `Sqlite_query ] diff --git a/src/lang/term/parsed_term.ml b/src/lang/term/parsed_term.ml index d6a842db44..8144ac2aba 100644 --- a/src/lang/term/parsed_term.ml +++ b/src/lang/term/parsed_term.ml @@ -123,6 +123,7 @@ and let_decoration = | `Sqlite_query | `Sqlite_row | `Yaml_parse + | `Xml_parse | `Json_parse of (string * t) list ] and _let = { diff --git a/src/lang/term/term_preprocessor.ml b/src/lang/term/term_preprocessor.ml index 98d4dc8571..85f1d23978 100644 --- a/src/lang/term/term_preprocessor.ml +++ b/src/lang/term/term_preprocessor.ml @@ -93,6 +93,7 @@ and expand_term tm = | `Sqlite_query -> `Sqlite_query | `Sqlite_row -> `Sqlite_row | `Yaml_parse -> `Yaml_parse + | `Xml_parse -> `Xml_parse | `Json_parse l -> `Json_parse (List.map (fun (lbl, t) -> (lbl, expand_term t)) l) in diff --git a/src/lang/term/term_reducer.ml b/src/lang/term/term_reducer.ml index 38164aa2e0..2edcc8bd82 100644 --- a/src/lang/term/term_reducer.ml +++ b/src/lang/term/term_reducer.ml @@ -937,6 +937,14 @@ let mk_let_json_parse ~pos (args, pat, def, cast) body = let def = mk ~pos (`Cast { cast = def; typ = ty }) in pattern_reducer ~body ~pat def +let mk_let_xml_parse ~pos (pat, def, cast) body = + let ty = match cast with Some ty -> ty | None -> mk_var ~pos () in + let tty = Value.RuntimeType.to_term ty in + let parser = mk ~pos (`Var "_internal_xml_parser_") in + let def = mk ~pos (`App (parser, [("type", tty); ("", def)])) in + let def = mk ~pos (`Cast { cast = def; typ = ty }) in + pattern_reducer ~body ~pat def + let mk_let_yaml_parse ~pos (pat, def, cast) body = let ty = match cast with Some ty -> ty | None -> mk_var ~pos () in let tty = Value.RuntimeType.to_term ty in @@ -1019,6 +1027,7 @@ let string_of_let_decoration = function | `Sqlite_query -> "sqlite.query" | `Sqlite_row -> "sqlite.row" | `Yaml_parse -> "yaml.parse" + | `Xml_parse -> "xml.parse" | `Json_parse _ -> "json.parse" let mk_let ~env ~pos ~to_term ~comments @@ -1094,6 +1103,9 @@ let mk_let ~env ~pos ~to_term ~comments | None, `Yaml_parse -> let body = mk_body def in mk_let_yaml_parse ~pos (pat, def, cast) body + | None, `Xml_parse -> + let body = mk_body def in + mk_let_xml_parse ~pos (pat, def, cast) body | None, `Sqlite_row -> let body = mk_body def in mk_let_sqlite_row ~pos (pat, def, cast) body diff --git a/src/lang/value.ml b/src/lang/value.ml index 714168ab74..f1492170ed 100644 --- a/src/lang/value.ml +++ b/src/lang/value.ml @@ -215,13 +215,15 @@ let make ?pos ?(methods = Methods.empty) ?(flags = Flags.empty) : in_value -> t Fun { pos; methods; flags; fun_args; fun_env; fun_body } | `FFI { ffi_args; ffi_fn } -> FFI { pos; methods; flags; ffi_args; ffi_fn } +let string_of_int_value ~flags i = + if Flags.has flags Flags.octal_int then Printf.sprintf "0o%o" i + else if Flags.has flags Flags.hex_int then Printf.sprintf "0x%x" i + else string_of_int i + let rec to_string v = let base_string v = match v with - | Int { value = i; flags } -> - if Flags.has flags Flags.octal_int then Printf.sprintf "0o%o" i - else if Flags.has flags Flags.hex_int then Printf.sprintf "0x%x" i - else string_of_int i + | Int { value = i; flags } -> string_of_int_value ~flags i | Float { value = f } -> Utils.string_of_float f | Bool { value = b } -> string_of_bool b | String { value = s } -> Lang_string.quote_string s diff --git a/src/tooling/parsed_json.ml b/src/tooling/parsed_json.ml index ef4a055cfe..8447243e2e 100644 --- a/src/tooling/parsed_json.ml +++ b/src/tooling/parsed_json.ml @@ -302,6 +302,7 @@ let json_of_let_decoration ~to_json : Parsed_term.let_decoration -> Json.t = `Assoc (ast_node ~typ:"var" [("value", `String "sqlite.row")]) | `Yaml_parse -> `Assoc (ast_node ~typ:"var" [("value", `String "yaml.parse")]) + | `Xml_parse -> `Assoc (ast_node ~typ:"var" [("value", `String "xml.parse")]) | `Json_parse [] -> `Assoc (ast_node ~typ:"var" [("value", `String "json.parse")]) | `Json_parse args -> diff --git a/tests/language/dune.inc b/tests/language/dune.inc index ad336f2801..97e6172299 100644 --- a/tests/language/dune.inc +++ b/tests/language/dune.inc @@ -527,6 +527,18 @@ (:run_test ../run_test.exe)) (action (run %{run_test} various.liq liquidsoap %{test_liq} various.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + xml_test.liq + ../../src/bin/liquidsoap.exe + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} xml_test.liq liquidsoap %{test_liq} xml_test.liq))) + (rule (alias citest) (package liquidsoap) diff --git a/tests/language/xml_test.liq b/tests/language/xml_test.liq new file mode 100644 index 0000000000..e242e945f9 --- /dev/null +++ b/tests/language/xml_test.liq @@ -0,0 +1,132 @@ +def f() = + s = + ' +gni + +bla +1.23 +false +123 +' + + let xml.parse (x : + { + bla: { + foo: string.{ xml_params: {opt: float} }, + bar: (string? * string?.{ xml_params: [(string * string)] }), + blo: float, + blu: bool, + ble: int, + xml_params: [(string * string)].{ bla: bool } + } + } + ) = s + + test.equal( + x, + { + bla= + { + xml_params=[("param", "1"), ("bla", "true")].{bla=true}, + ble=123, + blu=false, + blo=1.23, + bar=(null(), "bla".{xml_params=[("option", "aab")]}), + foo="gni".{xml_params={opt=12.3}} + } + } + ) + + test.equal( + xml.stringify( + { + bla= + { + xml_params=[("param", "1"), ("bla", "true")], + bar="bla".{xml_params=[("option", "aab")]}, + foo=true.{xml_params={opt=12.3}} + } + } + ), + ' + bla + true +' + ) + + let xml.parse (x : + ( + string + * + { + xml_params: [(string * string)], + xml_children: [ + ( + string + * + { + xml_params: [(string * string)], + xml_children: [(string * {xml_text: string})] + } + ) + ] + } + ) + ) = s + + test.equal( + x, + ( + "bla", + { + xml_children= + [ + ( + "foo", + { + xml_children=[("xml_text", {xml_text="gni"})], + xml_params=[("opt", "12.3")] + } + ), + ("bar", {xml_children=[], xml_params=[]}), + ( + "bar", + { + xml_children=[("xml_text", {xml_text="bla"})], + xml_params=[("option", "aab")] + } + ), + ( + "blo", + {xml_children=[("xml_text", {xml_text="1.23"})], xml_params=[]} + ), + ( + "blu", + {xml_children=[("xml_text", {xml_text="false"})], xml_params=[]} + ), + ( + "ble", + {xml_children=[("xml_text", {xml_text="123"})], xml_params=[]} + ) + ], + xml_params=[("param", "1"), ("bla", "true")] + } + ) + ) + + test.equal( + xml.stringify(x), + ' + gni + + bla + 1.23 + false + 123 +' + ) + + test.pass() +end + +test.check(f) From 149c064a8d00aac6b79a6813ab6c5e064853df9a Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 13 Dec 2024 14:51:06 +0100 Subject: [PATCH 146/151] Add source.drop.track_marks and source.drop.metadata_track_marks, update doc. --- doc/content/faq.md | 6 ++---- src/libs/tracks.liq | 14 ++++++++++++++ 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/doc/content/faq.md b/doc/content/faq.md index d184dcc233..c27a74a8c3 100644 --- a/doc/content/faq.md +++ b/doc/content/faq.md @@ -200,10 +200,8 @@ Players that are not affected include ogg123, liquidsoap. One way to work around this problem is to not use Ogg/Vorbis (which we do not recommend) or to not produce tracks within a Vorbis stream. -This is done by merging liquidsoap tracks (for example using -`add(normalize=false,[blank(),source])`) -and also not passing any metadata -(which is also a result of the previous snippet). +This is done by dropping both metadata and track marks (for example +using `source.drop.metadata_track_marks`). ### Encoding blank diff --git a/src/libs/tracks.liq b/src/libs/tracks.liq index 9d0affa81c..b94fb4d122 100644 --- a/src/libs/tracks.liq +++ b/src/libs/tracks.liq @@ -64,6 +64,20 @@ def source.drop.metadata(~id=null(), s) = source(id=id, tracks) end +# Remove the track marks of a source. +# @category Source / Track processing +def source.drop.track_marks(~id=null(), s) = + let {track_marks = _, ...tracks} = source.tracks(s) + source(id=id, tracks) +end + +# Remove the metadata and track marks of a source. +# @category Source / Track processing +def source.drop.metadata_track_marks(~id=null(), s) = + let {metadata = _, track_marks = _, ...tracks} = source.tracks(s) + source(id=id, tracks) +end + let settings.amplify = settings.make.void( "Settings for the amplify operator" From e5d8a5fdf64051041a090070640dfc0ab85170f8 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 14 Dec 2024 06:55:59 -0600 Subject: [PATCH 147/151] Reimplement audioscrobbler natively (#4250) --- CHANGES.md | 2 + doc/content/liq/radiopi.liq | 19 +- dune-project | 2 - liquidsoap-core.opam | 2 - src/config/lastfm_option.disabled.ml | 1 - src/config/lastfm_option.enabled.ml | 1 - src/core/builtins/builtins_lastfm.ml | 110 ------ src/core/builtins/builtins_optionals.ml | 1 - src/core/dune | 14 - src/core/tools/liqfm.ml | 244 ------------ src/libs/extra/audioscrobbler.liq | 476 ++++++++++++++++++++++++ src/libs/extra/lastfm.liq | 185 --------- src/libs/http.liq | 17 + src/libs/stdlib.liq | 2 +- src/runtime/build_config.ml | 1 - 15 files changed, 506 insertions(+), 571 deletions(-) delete mode 120000 src/config/lastfm_option.disabled.ml delete mode 120000 src/config/lastfm_option.enabled.ml delete mode 100644 src/core/builtins/builtins_lastfm.ml delete mode 100644 src/core/tools/liqfm.ml create mode 100644 src/libs/extra/audioscrobbler.liq delete mode 100644 src/libs/extra/lastfm.liq diff --git a/CHANGES.md b/CHANGES.md index a47e28636c..989fc402c2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,8 @@ New: wav dexcoder. - Added optional `buffer_size` parameter to `input.alsa` and `output.alsa` (#4243) +- Reimplemented audioscrobbler support natively using the more + recent protocol (#4250) Changed: diff --git a/doc/content/liq/radiopi.liq b/doc/content/liq/radiopi.liq index 06553b29bd..9a2e9fb291 100644 --- a/doc/content/liq/radiopi.liq +++ b/doc/content/liq/radiopi.liq @@ -128,9 +128,9 @@ interlude = single("/home/radiopi/fallback.mp3") # Lastfm submission def lastfm(m) = if - (m["type"] == "chansons") - then - if + m["type"] == "chansons" + and + ( m["canal"] == "reggae" or @@ -138,12 +138,13 @@ def lastfm(m) = or m["canal"] == "That70Sound" ) - then - canal = - if (m["canal"] == "That70Sound") then "70sound" else m["canal"] end - user = "radiopi-" ^ canal - lastfm.submit(user=user, password="xXXxx", m) - end + + then + canal = if (m["canal"] == "That70Sound") then "70sound" else m["canal"] end + username = "radiopi-" ^ canal + audioscrobbler.api.track.scrobble.metadata( + username=username, password="xXXxx", m + ) end end diff --git a/dune-project b/dune-project index b1f1a11f16..7b1be7b7f6 100644 --- a/dune-project +++ b/dune-project @@ -83,7 +83,6 @@ jemalloc ladspa lame - lastfm lilv lo mad @@ -123,7 +122,6 @@ (inotify (< 1.0)) (ladspa (< 0.2.0)) (lame (< 0.3.7)) - (lastfm (< 0.3.4)) (lo (< 0.2.0)) (mad (< 0.5.0)) (magic (< 0.6)) diff --git a/liquidsoap-core.opam b/liquidsoap-core.opam index 9f33a5b40e..6a75736720 100644 --- a/liquidsoap-core.opam +++ b/liquidsoap-core.opam @@ -48,7 +48,6 @@ depopts: [ "jemalloc" "ladspa" "lame" - "lastfm" "lilv" "lo" "mad" @@ -89,7 +88,6 @@ conflicts: [ "inotify" {< "1.0"} "ladspa" {< "0.2.0"} "lame" {< "0.3.7"} - "lastfm" {< "0.3.4"} "lo" {< "0.2.0"} "mad" {< "0.5.0"} "magic" {< "0.6"} diff --git a/src/config/lastfm_option.disabled.ml b/src/config/lastfm_option.disabled.ml deleted file mode 120000 index 370c3e56d3..0000000000 --- a/src/config/lastfm_option.disabled.ml +++ /dev/null @@ -1 +0,0 @@ -noop.disabled.ml \ No newline at end of file diff --git a/src/config/lastfm_option.enabled.ml b/src/config/lastfm_option.enabled.ml deleted file mode 120000 index 34bd7cbe43..0000000000 --- a/src/config/lastfm_option.enabled.ml +++ /dev/null @@ -1 +0,0 @@ -noop.enabled.ml \ No newline at end of file diff --git a/src/core/builtins/builtins_lastfm.ml b/src/core/builtins/builtins_lastfm.ml deleted file mode 100644 index dd743b3b09..0000000000 --- a/src/core/builtins/builtins_lastfm.ml +++ /dev/null @@ -1,110 +0,0 @@ -(***************************************************************************** - - Liquidsoap, a programmable stream generator. - Copyright 2003-2024 Savonet team - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details, fully stated in the COPYING - file at the root of the liquidsoap distribution. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - - *****************************************************************************) - -let audioscrobbler = Lang.add_module "audioscrobbler" -let log = Log.make ["lastfm"; "submit"] - -let () = - let f name stype descr = - let proto = - [ - ("user", Lang.string_t, None, None); - ("password", Lang.string_t, None, None); - ( "host", - Lang.string_t, - Some (Lang.string !Liqfm.Audioscrobbler.base_host), - Some "Host for audioscrobbling submissions." ); - ( "port", - Lang.int_t, - Some (Lang.int !Liqfm.Audioscrobbler.base_port), - Some "Port for audioscrobbling submissions." ); - ( "length", - Lang.bool_t, - Some (Lang.bool false), - Some - "Try to submit length information. This operation can be CPU \ - intensive. Value forced to true when used with the \"user\" \ - source type." ); - ("", Lang.metadata_t, None, None); - ] - in - let proto = - if stype = Liqfm.Played then - ( "source", - Lang.string_t, - Some (Lang.string "broadcast"), - Some - "Source for tracks. Should be one of: \"broadcast\", \"user\", \ - \"recommendation\" or \"unknown\". Since liquidsoap is intended \ - for radio broadcasting, this is the default. Sources other than \ - user don't need duration to be set." ) - :: proto - else proto - in - let tasks = Hashtbl.create 1 in - ignore - (Lang.add_builtin ~base:audioscrobbler name - ~category:`Interaction (* TODO better cat *) ~descr proto Lang.unit_t - (fun p -> - let user = Lang.to_string (List.assoc "user" p) in - let password = Lang.to_string (List.assoc "password" p) in - let metas = Lang.to_metadata (Lang.assoc "" 1 p) in - let host = Lang.to_string (List.assoc "host" p) in - let port = Lang.to_int (List.assoc "port" p) in - let host = (host, port) in - let mode = - if stype = Liqfm.Played then ( - match Lang.to_string (List.assoc "source" p) with - | "broadcast" -> Liqfm.Broadcast - | "user" -> Liqfm.User - | "recommendation" -> Liqfm.Recommendation - | "unknown" -> Liqfm.Unknown - | _ -> - raise - (Error.Invalid_value - ( List.assoc "source" p, - "unknown lastfm submission mode" ))) - else Liqfm.Unknown - in - let length = Lang.to_bool (List.assoc "length" p) in - let length = - if length = false && mode = Liqfm.User then ( - log#severe - "length information is required for \"user\" sources, setting \ - to true."; - true) - else length - in - let task = - try Hashtbl.find tasks host - with Not_found -> - let t = Liqfm.init host in - Hashtbl.replace tasks host t; - t - in - Liqfm.submit (user, password) task length mode stype [metas]; - Lang.unit)) - in - f "submit" Liqfm.Played - "Submit a played song using the audioscrobbler protocol."; - f "nowplaying" Liqfm.NowPlaying - "Submit a now playing song using the audioscrobbler protocol." diff --git a/src/core/builtins/builtins_optionals.ml b/src/core/builtins/builtins_optionals.ml index 8544b6532f..bf0cee5700 100644 --- a/src/core/builtins/builtins_optionals.ml +++ b/src/core/builtins/builtins_optionals.ml @@ -28,7 +28,6 @@ let () = ("irc", Irc_option.enabled); ("ladspa", Ladspa_option.enabled); ("lame", Lame_option.enabled); - ("lastfm", Lastfm_option.enabled); ("lilv", Lilv_option.enabled); ("lo", Lo_option.enabled); ("mad", Mad_option.enabled); diff --git a/src/core/dune b/src/core/dune index 6933405e89..111931789c 100644 --- a/src/core/dune +++ b/src/core/dune @@ -465,14 +465,6 @@ (optional) (modules lame_encoder)) -(library - (name liquidsoap_lastfm) - (libraries lastfm liquidsoap_core) - (library_flags -linkall) - (wrapped false) - (optional) - (modules builtins_lastfm liqfm)) - (library (name liquidsoap_lilv) (libraries lilv liquidsoap_core) @@ -737,7 +729,6 @@ jemalloc_option ladspa_option lame_option - lastfm_option lilv_option lo_option mad_option @@ -858,11 +849,6 @@ from (liquidsoap_lame -> lame_option.enabled.ml) (-> lame_option.disabled.ml)) - (select - lastfm_option.ml - from - (liquidsoap_lastfm -> lastfm_option.enabled.ml) - (-> lastfm_option.disabled.ml)) (select lilv_option.ml from diff --git a/src/core/tools/liqfm.ml b/src/core/tools/liqfm.ml deleted file mode 100644 index d4c0eeddad..0000000000 --- a/src/core/tools/liqfm.ml +++ /dev/null @@ -1,244 +0,0 @@ -(***************************************************************************** - - Liquidsoap, a programmable stream generator. - Copyright 2003-2024 Savonet team - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details, fully stated in the COPYING - file at the root of the liquidsoap distribution. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - - *****************************************************************************) - -(* A custom implementation of HTTP - * requests. *) -module Liq_http = struct - type request = Get | Post of string - - exception Http of string - - let exc_of_exc = function - | Http s -> Http s - | e -> Http (Printexc.to_string e) - - (* This in unused for now.. *) - let default_timeout = ref 50. - - let request ?timeout ?headers ?(port = 80) ~host ~url ~request () = - try - let timeout = - match timeout with None -> !default_timeout | Some t -> t - in - let mk_read s = - let buf = Buffer.create 10 in - Buffer.add_string buf s; - fun len -> - let len = min (Buffer.length buf) len in - let ret = Buffer.sub buf 0 len in - Utils.buffer_drop buf len; - ret - in - let request = - match request with - | Get -> `Get - | Post s -> `Post (Some (Int64.of_int (String.length s)), mk_read s) - in - let url = Printf.sprintf "http://%s:%d%s" host port url in - let data = Buffer.create 1024 in - let x, code, y, _ = - Liqcurl.http_request ?headers ~pos:[] ~follow_redirect:true - ~on_body_data:(Buffer.add_string data) - ~timeout:(Some (int_of_float (timeout *. 1000.))) - ~url ~request () - in - if code <> 200 then - raise (Http (Printf.sprintf "Http request failed: %s %i %s" x code y)); - Buffer.contents data - with e -> raise (exc_of_exc e) -end - -module Audioscrobbler = Lastfm_generic.Audioscrobbler_generic (Liq_http) - -let error_translator = function - | Audioscrobbler.Error x -> - Some - (Printf.sprintf "Audioscrobbler error: %s" - (Audioscrobbler.string_of_error x)) - | _ -> None - -let () = Printexc.register_printer error_translator - -open Lastfm_generic -open Audioscrobbler - -type source = User | Lastfm | Broadcast | Recommendation | Unknown -type submission = NowPlaying | Played - -type task = { - task : Duppy.Async.t; - submit_m : Mutex.t; - submissions : - (string * string * source * submission * bool * Frame.metadata) Queue.t; -} - -let log = Log.make ["audioscrobbler"] - -exception Duration - -let client = { client = "lsp"; version = "0.1" } - -let init host = - (* The list of waiting submissions *) - let submissions = Queue.create () in - (* A mutex to manage thread concurrency *) - let submit_m = Mutex.create () in - let reason s = log#important "Lastfm Submission failed: %s" s in - (* Define a new task *) - let do_submit () = - try - (* This function checks that the submission is valid *) - let song songs (user, password, (source : source), stype, length, m) = - let login = { user; password } in - let f x = try Frame.Metadata.find x m with Not_found -> "" in - let artist, track = (f "artist", f "title") in - let s = - match stype with Played -> "submit" | NowPlaying -> "nowplaying" - in - let h, p = host in - log#info "Submitting %s -- %s with mode: %s to %s:%i" artist track s h p; - try - let duration () = - try - match float_of_string_opt (Frame.Metadata.find "duration" m) with - | Some d -> d - | None -> raise Not_found - with Not_found -> ( - let exception Bad_rid in - try - let rid = - match int_of_string_opt (Frame.Metadata.find "rid" m) with - | Some rid -> rid - | None -> raise Bad_rid - in - let request = Request.from_id rid in - match request with - | Some s -> ( - match Request.get_filename s with - | Some file -> ( - match - Request.duration ~metadata:(Request.metadata s) - file - with - | Some f -> f - | None -> raise Not_found) - | None -> raise Not_found) - | None -> raise Not_found - with - | Not_found -> raise Duration - | Bad_rid -> - log#severe "Metadata 'rid' is not associated to an integer!"; - raise Duration) - in - let duration = - if length then ( - try Some (duration ()) - with Duration -> if source = User then raise Duration else None) - else if source <> User then None - else raise Duration - in - let time = Unix.time () in - let trackauth = - (* Only when source is lasftm *) - match source with - | Lastfm -> Some (f "lastfm:trackauth") - | _ -> None - in - let source = - match source with - | User -> Audioscrobbler.User - | Lastfm -> Audioscrobbler.Lastfm - | Broadcast -> Audioscrobbler.Broadcast - | Recommendation -> Audioscrobbler.Recommendation - | Unknown -> Audioscrobbler.Unknown - in - let song = - { - artist; - track; - time = Some time; - source = Some source; - rating = None; - length = duration; - album = Some (f "album"); - tracknumber = None; - musicbrainzid = None; - trackauth; - } - in - check_song song Submit; - (login, stype, song) :: songs - with - | Duration -> - log#info "could not submit track %s -- %s, no duration available" - artist track; - songs - | Error e -> - log#info "could not submit track %s -- %s, %s" artist track - (string_of_error e); - songs - | e -> - log#info "could not submit track %s -- %s: unknown error %s" - artist track (Printexc.to_string e); - songs - in - Mutex.lock submit_m; - let songs = Queue.fold song [] submissions in - Queue.clear submissions; - Mutex.unlock submit_m; - let submit = Hashtbl.create 10 in - let filter (c, t, m) = - try - let v = Hashtbl.find submit (c, t) in - Hashtbl.replace submit (c, t) (m :: v) - with Not_found -> Hashtbl.replace submit (c, t) [m] - in - List.iter filter songs; - let f (login, (stype : submission)) songs = - try - match stype with - | NowPlaying -> - List.iter - (fun song -> Audioscrobbler.do_np ~host client login song) - songs - | Played -> - ignore (Audioscrobbler.do_submit ~host client login songs) - with Audioscrobbler.Error e -> - reason (Audioscrobbler.string_of_error e) - in - Hashtbl.iter f submit; - -1. - with e -> - reason (Printexc.to_string e); - -1. - in - let task = Duppy.Async.add ~priority:`Blocking Tutils.scheduler do_submit in - { task; submit_m; submissions } - -let submit (user, password) task length source stype songs = - let songs = - List.map (fun x -> (user, password, source, stype, length, x)) songs - in - Mutex.lock task.submit_m; - List.iter (fun x -> Queue.add x task.submissions) songs; - Mutex.unlock task.submit_m; - Duppy.Async.wake_up task.task diff --git a/src/libs/extra/audioscrobbler.liq b/src/libs/extra/audioscrobbler.liq new file mode 100644 index 0000000000..48b339185a --- /dev/null +++ b/src/libs/extra/audioscrobbler.liq @@ -0,0 +1,476 @@ +let error.audioscrobbler = error.register("audioscrobbler") + +let settings.audioscrobbler = + settings.make.void( + "Audioscrobbler settings" + ) + +let settings.audioscrobbler.api_key = + settings.make( + description= + "Default API key for audioscrobbler", + "" + ) + +let settings.audioscrobbler.api_secret = + settings.make( + description= + "Default API secret for audioscrobbler", + "" + ) + +audioscrobbler = () + +def audioscrobbler.request( + ~base_url="http://ws.audioscrobbler.com/2.0", + ~api_key=null(), + ~api_secret=null(), + params +) = + api_key = api_key ?? settings.audioscrobbler.api_key() + api_secret = api_secret ?? settings.audioscrobbler.api_secret() + + if + api_key == "" or api_secret == "" + then + error.raise( + error.audioscrobbler, + "`api_key` or `api_secret` missing!" + ) + end + + params = [("api_key", api_key), ...params] + + sig_params = list.sort(fun (v, v') -> string.compare(fst(v), fst(v')), params) + sig_params = list.map(fun (v) -> "#{fst(v)}#{(snd(v) : string)}", sig_params) + sig_params = string.concat(separator="", sig_params) + + api_sig = string.digest("#{sig_params}#{api_secret}") + + http.post( + base_url, + headers=[("Content-Type", "application/x-www-form-urlencoded")], + data=http.www_form_urlencoded([...params, ("api_sig", api_sig)]) + ) +end + +def audioscrobbler.check_response(resp) = + let xml.parse ({lfm = {xml_params = {status}}} : + {lfm: {xml_params: {status: string}}} + ) = resp + if + (status == "failed") + then + error_ref = error + let xml.parse ({lfm = {error = {xml_params = {code}}}} : + {lfm: {error: string.{ xml_params: {code: int} }}} + ) = resp + error_ref.raise( + error_ref.audioscrobbler, + "Error #{code}: #{error}" + ) + end +end + +def audioscrobbler.auth( + ~username, + ~password, + ~api_key=null(), + ~api_secret=null() +) = + resp = + audioscrobbler.request( + api_key=api_key, + api_secret=api_secret, + [ + ("method", "auth.getMobileSession"), + ("username", username), + ("password", password) + ] + ) + + audioscrobbler.check_response(resp) + + try + let xml.parse ({lfm = {session = {name, key}}} : + {lfm: {session: {name: string, key: string}}} + ) = resp + assert(name == username) + key + catch err do + error.raise( + error.invalid, + "Invalid response: #{resp}, error: #{err}" + ) + end +end + +let audioscrobbler.api = {track=()} + +# Submit a track to the audioscrobbler +# `track.updateNowPlaying` API. +# @category Interaction +def audioscrobbler.api.track.updateNowPlaying( + ~username, + ~password, + ~session_key=null(), + ~api_key=null(), + ~api_secret=null(), + ~artist, + ~track, + ~album=null(), + ~context=null(), + ~trackNumber=null(), + ~mbid=null(), + ~albumArtist=null(), + ~duration=null() +) = + session_key = + session_key + ?? + audioscrobbler.auth( + username=username, + password=password, + api_key=api_key, + api_secret=api_secret + ) + + params = + [ + ("track", track), + ("artist", artist), + ...(null.defined(album) ? [("album", null.get(album))] : [] ), + ...(null.defined(context) ? [("context", null.get(context))] : [] ), + ...( + null.defined(trackNumber) + ? [("trackNumber", string((null.get(trackNumber) : int)))] : [] + ), + ...(null.defined(mbid) ? [("mbid", null.get(mbid))] : [] ), + ...( + null.defined(albumArtist) + ? [("albumArtist", null.get(albumArtist))] : [] + ), + ...( + null.defined(duration) + ? [("duration", string((null.get(duration) : int)))] : [] + ) + ] + + log.info( + label="audioscrobbler.api.track.updateNowPlaying", + "Submitting updateNowPlaying with: #{params}" + ) + + resp = + audioscrobbler.request( + api_key=api_key, + api_secret=api_secret, + [...params, ("method", "track.updateNowPlaying"), ("sk", session_key)] + ) + + audioscrobbler.check_response(resp) + + try + let xml.parse (v : + { + lfm: { + nowplaying: { + track: string.{ xml_params: {corrected: int} }, + artist: string.{ xml_params: {corrected: int} }, + album: string?.{ xml_params: {corrected: int} }, + albumArtist: string?.{ xml_params: {corrected: int} }, + ignoredMessage: {xml_params: {code: int}} + }, + xml_params: {status: string} + } + } + ) = resp + + log.info( + label="audioscrobbler.api.track.updateNowPlaying", + "Done submitting updateNowPlaying with: #{params}" + ) + + v + catch err do + error.raise( + error.invalid, + "Invalid response: #{resp}, error: #{err}" + ) + end +end + +# @flag hidden +def audioscrobbler.api.apply_meta( + ~name, + ~username, + ~password, + ~api_key, + ~api_secret, + ~session_key, + fn, + m +) = + def c(v) = + v == "" ? null() : v + end + track = m["title"] + artist = m["artist"] + + if + track == "" or artist == "" + then + log.info( + label=name, + "No artist or track present: metadata submission disabled!" + ) + else + album = c(m["album"]) + trackNumber = + try + null.map(int_of_string, c(m["tracknumber"])) + catch _ do + null() + end + albumArtist = c(m["albumartist"]) + ignore( + fn( + username=username, + password=password, + api_key=api_key, + api_secret=api_secret, + session_key=session_key, + track=track, + artist=artist, + album=album, + trackNumber=trackNumber, + albumArtist=albumArtist + ) + ) + end +end + +# Submit a track using its metadata to the audioscrobbler +# `track.updateNowPlaying` API. +# @category Interaction +def audioscrobbler.api.track.updateNowPlaying.metadata( + ~username, + ~password, + ~session_key=null(), + ~api_key=null(), + ~api_secret=null(), + m +) = + audioscrobbler.api.apply_meta( + username=username, + password=password, + session_key=session_key, + api_key=api_key, + api_secret=api_secret, + name="audioscrobbler.api.track.updateNowPlaying", + audioscrobbler.api.track.updateNowPlaying, + m + ) +end + +# Submit a track to the audioscrobbler +# `track.scrobble` API. +# @category Interaction +def audioscrobbler.api.track.scrobble( + ~username, + ~password, + ~session_key=null(), + ~api_key=null(), + ~api_secret=null(), + ~artist, + ~track, + ~timestamp=time(), + ~album=null(), + ~context=null(), + ~streamId=null(), + ~chosenByUser=true, + ~trackNumber=null(), + ~mbid=null(), + ~albumArtist=null(), + ~duration=null() +) = + session_key = + session_key + ?? + audioscrobbler.auth( + username=username, + password=password, + api_key=api_key, + api_secret=api_secret + ) + + params = + [ + ("track", track), + ("artist", artist), + ("timestamp", string(timestamp)), + ...(null.defined(album) ? [("album", null.get(album))] : [] ), + ...(null.defined(context) ? [("context", null.get(context))] : [] ), + ...(null.defined(streamId) ? [("streamId", null.get(streamId))] : [] ), + + ("chosenByUser", chosenByUser ? "1" : "0" ), + ...( + null.defined(trackNumber) + ? [("trackNumber", string((null.get(trackNumber) : int)))] : [] + ), + ...(null.defined(mbid) ? [("mbid", null.get(mbid))] : [] ), + ...( + null.defined(albumArtist) + ? [("albumArtist", null.get(albumArtist))] : [] + ), + ...( + null.defined(duration) + ? [("duration", string((null.get(duration) : int)))] : [] + ) + ] + + log.info( + label="audioscrobbler.api.track.scrobble", + "Submitting updateNowPlaying with: #{params}" + ) + + resp = + audioscrobbler.request( + api_key=api_key, + api_secret=api_secret, + [...params, ("method", "track.scrobble"), ("sk", session_key)] + ) + + audioscrobbler.check_response(resp) + + try + let xml.parse (v : + { + lfm: { + scrobbles: { + scrobble: { + track: string.{ xml_params: {corrected: int} }, + artist: string.{ xml_params: {corrected: int} }, + album: string?.{ xml_params: {corrected: int} }, + albumArtist: string?.{ xml_params: {corrected: int} }, + timestamp: float, + ignoredMessage: {xml_params: {code: int}} + }, + xml_params: {ignored: int, accepted: int} + }, + xml_params: {status: string} + } + } + ) = resp + + log.info( + label="audioscrobbler.api.track.scrobble", + "Done submitting scrobble with: #{params}" + ) + + v + catch err do + error.raise( + error.invalid, + "Invalid response: #{resp}, error: #{err}" + ) + end +end + +# Submit a track to the audioscrobbler +# `track.scrobble` API using its metadata. +# @category Interaction +def audioscrobbler.api.track.scrobble.metadata( + ~username, + ~password, + ~session_key=null(), + ~api_key=null(), + ~api_secret=null(), + m +) = + audioscrobbler.api.apply_meta( + username=username, + password=password, + session_key=session_key, + api_key=api_key, + api_secret=api_secret, + name="audioscrobbler.api.track.scrobble", + audioscrobbler.api.track.scrobble, + m + ) +end + +# Submit songs using audioscrobbler, respecting the full protocol: +# First signal song as now playing when starting, and +# then submit song when it ends. +# @category Interaction +# @flag extra +# @param ~source Source for tracks. Should be one of: "broadcast", "user", "recommendation" or "unknown". Since liquidsoap is intended for radio broadcasting, this is the default. Sources other than user don't need duration to be set. +# @param ~delay Submit song when there is only this delay left, in seconds. +# @param ~force If remaining time is null, the song will be assumed to be skipped or cut, and not submitted. Set this to `true` to prevent this behavior +# @param ~metadata_preprocessor Metadata pre-processor callback. Can be used to change metadata on-the-fly before sending to nowPlaying/scrobble. If returning an empty metadata, nothing is sent at all. +def audioscrobbler.submit( + ~username, + ~password, + ~api_key=null(), + ~api_secret=null(), + ~delay=10., + ~force=false, + ~metadata_preprocessor=fun (m) -> m, + s +) = + session_key = + audioscrobbler.auth( + username=username, + password=password, + api_key=api_key, + api_secret=api_secret + ) + + def now_playing(m) = + try + audioscrobbler.api.track.updateNowPlaying.metadata( + username=username, + password=password, + api_key=api_key, + api_secret=api_secret, + session_key=session_key, + metadata_preprocessor(m) + ) + catch err do + log.important( + "Error while submitting nowplaying info for #{source.id(s)}: #{err}" + ) + end + end + + s = source.on_metadata(s, now_playing) + f = + fun (rem, m) -> + # Avoid skipped songs + if + rem > 0. or force + then + try + audioscrobbler.api.track.scrobble.metadata( + username=username, + password=password, + api_key=api_key, + api_secret=api_secret, + session_key=session_key, + metadata_preprocessor(m) + ) + catch err do + log.important( + "Error while submitting scrobble info for #{source.id(s)}: #{err}" + ) + end + else + log( + label="audioscrobbler.submit", + level=4, + "Remaining time null: will not submit song (song skipped ?)" + ) + end + source.on_end(s, delay=delay, f) +end diff --git a/src/libs/extra/lastfm.liq b/src/libs/extra/lastfm.liq deleted file mode 100644 index 8e2405c0d4..0000000000 --- a/src/libs/extra/lastfm.liq +++ /dev/null @@ -1,185 +0,0 @@ -%ifdef audioscrobbler.submit -librefm = () -lastfm = () - -# Submit metadata to libre.fm using the audioscrobbler protocol. -# @category Interaction -# @flag extra -# @param ~source Source for tracks. Should be one of: "broadcast", "user", "recommendation" or "unknown". Since liquidsoap is intended for radio broadcasting, this is the default. Sources other than user don't need duration to be set. -# @param ~length Try to submit length information. This operation can be CPU intensive. Value forced to true when used with the "user" source type. -def librefm.submit(~user, ~password, ~source="broadcast", ~length=false, m) = - audioscrobbler.submit( - user=user, - password=password, - source=source, - length=length, - host="turtle.libre.fm", - port=80, - m - ) -end - -# Submit metadata to lastfm.fm using the audioscrobbler protocol. -# @category Interaction -# @flag extra -# @param ~source Source for tracks. Should be one of: "broadcast", "user", "recommendation" or "unknown". Since liquidsoap is intended for radio broadcasting, this is the default. Sources other than user don't need duration to be set. -# @param ~length Try to submit length information. This operation can be CPU intensive. Value forced to true when used with the "user" source type. -def lastfm.submit(~user, ~password, ~source="broadcast", ~length=false, m) = - audioscrobbler.submit( - user=user, - password=password, - source=source, - length=length, - host="post.audioscrobbler.com", - port=80, - m - ) -end - -# Submit metadata to libre.fm using the audioscrobbler protocol (nowplaying mode). -# @category Interaction -# @flag extra -# @param ~length Try to submit length information. This operation can be CPU intensive. Value forced to true when used with the "user" source type. -def librefm.nowplaying(~user, ~password, ~length=false, m) = - audioscrobbler.nowplaying( - user=user, - password=password, - length=length, - host="turtle.libre.fm", - port=80, - m - ) -end - -# Submit metadata to lastfm.fm using the audioscrobbler protocol (nowplaying mode). -# @category Interaction -# @flag extra -# @param ~length Try to submit length information. This operation can be CPU intensive. Value forced to true when used with the "user" source type. -def lastfm.nowplaying(~user, ~password, ~length=false, m) = - audioscrobbler.nowplaying( - user=user, - password=password, - length=length, - host="post.audioscrobbler.com", - port=80, - m - ) -end - -let source_on_end = source.on_end -let source_on_metadata = source.on_metadata - -# Submit songs using audioscrobbler, respecting the full protocol: -# First signal song as now playing when starting, and -# then submit song when it ends. -# @category Interaction -# @flag extra -# @param ~source Source for tracks. Should be one of: "broadcast", "user", "recommendation" or "unknown". Since liquidsoap is intended for radio broadcasting, this is the default. Sources other than user don't need duration to be set. -# @param ~length Try to submit length information. This operation can be CPU intensive. Value forced to true when used with the "user" source type. -# @param ~delay Submit song when there is only this delay left, in seconds. -# @param ~force If remaining time is null, the song will be assumed to be skipped or cut, and not submitted. Set to zero to disable this behaviour. -def audioscrobbler.submit.full( - ~user, - ~password, - ~host="post.audioscrobbler.com", - ~port=80, - ~source="broadcast", - ~length=false, - ~delay=10., - ~force=false, - s -) = - def f(m) = - audioscrobbler.nowplaying( - user=user, password=password, host=host, port=port, length=length, m - ) - end - - s = source_on_metadata(s, f) - f = - fun (rem, m) -> - # Avoid skipped songs - if - rem > 0. or force - then - audioscrobbler.submit( - user=user, - password=password, - host=host, - port=port, - length=length, - source=source, - m - ) - else - log( - label="audioscrobbler.submit.full", - level=4, - "Remaining time null: will not submit song (song skipped ?)" - ) - end - source_on_end(s, delay=delay, f) -end - -# Submit songs to librefm using audioscrobbler, respecting the full protocol: -# First signal song as now playing when starting, and -# then submit song when it ends. -# @category Interaction -# @flag extra -# @param ~source Source for tracks. Should be one of: "broadcast", "user", "recommendation" or "unknown". Since liquidsoap is intended for radio broadcasting, this is the default. Sources other than user don't need duration to be set. -# @param ~length Try to submit length information. This operation can be CPU intensive. Value forced to true when used with the "user" source type. -# @param ~delay Submit song when there is only this delay left, in seconds. If remaining time is less than this value, the song will be assumed to be skipped or cut, and not submitted. Set to zero to disable this behaviour. -# @param ~force If remaining time is null, the song will be assumed to be skipped or cut, and not submitted. Set to zero to disable this behaviour. -def librefm.submit.full( - ~user, - ~password, - ~source="broadcast", - ~length=false, - ~delay=10., - ~force=false, - s -) = - audioscrobbler.submit.full( - user=user, - password=password, - source=source, - length=length, - host="turtle.libre.fm", - port=80, - delay=delay, - force=force, - s - ) -end - -# Submit songs to lastfm using audioscrobbler, respecting the full protocol: -# First signal song as now playing when starting, and -# then submit song when it ends. -# @category Interaction -# @flag extra -# @param ~source Source for tracks. Should be one of: "broadcast", "user", "recommendation" or "unknown". Since liquidsoap is intended for radio broadcasting, this is the default. Sources other than user don't need duration to be set. -# @param ~length Try to submit length information. This operation can be CPU intensive. Value forced to true when used with the "user" source type. -# @param ~delay Submit song when there is only this delay left, in seconds. If remaining time is less than this value, the song will be assumed to be skipped or cut, and not submitted. Set to zero to disable this behaviour. -# @param ~force If remaining time is null, the song will be assumed to be skipped or cut, and not submitted. Set to zero to disable this behaviour. -def lastfm.submit.full( - ~user, - ~password, - ~source="broadcast", - ~length=false, - ~delay=10., - ~force=false, - s -) = - audioscrobbler.submit.full( - user=user, - password=password, - source=source, - length=length, - host="post.audioscrobbler.com", - port=80, - delay=delay, - force=force, - s - ) -end -%endif diff --git a/src/libs/http.liq b/src/libs/http.liq index cece16dd1b..70d550219a 100644 --- a/src/libs/http.liq +++ b/src/libs/http.liq @@ -1,5 +1,22 @@ # Set of HTTP utils. +# Prepare a list of `(string, string)` arguments for +# sending as `"application/x-www-form-urlencoded"` content +# @category Internet +def http.www_form_urlencoded(params) = + params = + list.map( + fun (v) -> + begin + let (key, value) = v + "#{url.encode(key)}=#{url.encode(value)}" + end, + params + ) + + string.concat(separator="&", params) +end + # Prepare a list of data to be sent as multipart form data. # @category Internet # @param ~boundary Specify boundary to use for multipart/form-data. diff --git a/src/libs/stdlib.liq b/src/libs/stdlib.liq index dacb255f90..51f708e55e 100644 --- a/src/libs/stdlib.liq +++ b/src/libs/stdlib.liq @@ -48,7 +48,7 @@ %include_extra "extra/source.liq" %include_extra "extra/http.liq" %include_extra "extra/externals.liq" -%include_extra "extra/lastfm.liq" +%include_extra "extra/audioscrobbler.liq" %include_extra "extra/server.liq" %include_extra "extra/telnet.liq" %include_extra "extra/interactive.liq" diff --git a/src/runtime/build_config.ml b/src/runtime/build_config.ml index 20495b0da7..206dfbacde 100644 --- a/src/runtime/build_config.ml +++ b/src/runtime/build_config.ml @@ -121,7 +121,6 @@ let build_config = - inotify : %{Inotify_option.detected} - irc : %{Irc_option.detected} - jemalloc : %{Jemalloc_option.detected} - - lastfm : %{Lastfm_option.detected} - lo : %{Lo_option.detected} - memtrace : %{Memtrace_option.detected} - osc : %{Osc_option.detected} From 9b674daff2b098ded931ebf8214d2e06bb0351e0 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 14 Dec 2024 15:29:48 +0100 Subject: [PATCH 148/151] Remove assert --- src/libs/extra/audioscrobbler.liq | 1 - 1 file changed, 1 deletion(-) diff --git a/src/libs/extra/audioscrobbler.liq b/src/libs/extra/audioscrobbler.liq index 48b339185a..0b37e75542 100644 --- a/src/libs/extra/audioscrobbler.liq +++ b/src/libs/extra/audioscrobbler.liq @@ -95,7 +95,6 @@ def audioscrobbler.auth( let xml.parse ({lfm = {session = {name, key}}} : {lfm: {session: {name: string, key: string}}} ) = resp - assert(name == username) key catch err do error.raise( From 2addd93da75c1561c03e77d82621763c49993e31 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 14 Dec 2024 15:36:05 +0100 Subject: [PATCH 149/151] Add migration doc for `source.dynamic`. Fixes: #4268 --- doc/content/migrating.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/doc/content/migrating.md b/doc/content/migrating.md index 3bfae7fd8f..cb264ca362 100644 --- a/doc/content/migrating.md +++ b/doc/content/migrating.md @@ -205,6 +205,17 @@ of gstreamer's features. See [this PR](https://github.com/savonet/liquidsoap/pul The default port for the Prometheus metrics exporter has changed from `9090` to `9599`. As before, you can change it with `settings.prometheus.server.port := `. +### `source.dynamic` + +Many operators such as `single` and `request.once` have been reworked to use `source.dynamic` as their underlying +implementation. + +The operator is now considered usable in production although we urge caution when using it: it is very powerful but can +also break things! + +If you were (boldly!) using this operator before, the most important change is that its `set` method has been removed in +favor of a unique callback API. + ## From 2.1.x to 2.2.x ### References From 5c579da479900c948ff5ed6a80342c6801350d09 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 14 Dec 2024 15:42:07 +0100 Subject: [PATCH 150/151] Fix this. --- doc/content/xml.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/content/xml.md b/doc/content/xml.md index deda87965e..17d5205892 100644 --- a/doc/content/xml.md +++ b/doc/content/xml.md @@ -35,7 +35,7 @@ let xml.parse (x : } ) = s -print("The value for blu is: #{x.bla.ble}") +print("The value for ble is: #{x.bla.ble}") ``` Things to note: From 8eb3049b9556e38b903b62aee719a5e3370bcdd6 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sat, 14 Dec 2024 16:07:55 +0100 Subject: [PATCH 151/151] Remove name. --- src/libs/extra/audioscrobbler.liq | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/extra/audioscrobbler.liq b/src/libs/extra/audioscrobbler.liq index 0b37e75542..5691a2f5be 100644 --- a/src/libs/extra/audioscrobbler.liq +++ b/src/libs/extra/audioscrobbler.liq @@ -92,7 +92,7 @@ def audioscrobbler.auth( audioscrobbler.check_response(resp) try - let xml.parse ({lfm = {session = {name, key}}} : + let xml.parse ({lfm = {session = {key}}} : {lfm: {session: {name: string, key: string}}} ) = resp key