<commit_before>(* Ocsigen
 * http://www.ocsigen.org
 * Module deflatemod.ml
 * Copyright (C) 2007 <NAME>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 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 Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)
(*****************************************************************************)
(*****************************************************************************)
(* This module allows to compress output sent by the server                  *)
(*****************************************************************************)
(*****************************************************************************)

open Lwt
open Ocsigen_extensions
open Simplexmlparser
open Ocsigen_headers


(* Content-type *)
type filter = Type of string option * string option | Extension of string
type compress_choice = All_but of filter list |
                       Compress_only of filter list

let should_compress (t, t') url choice_list =
 let check = function
 |Type (None, None) -> true
 |Type (None, Some x') -> x' = t'
 |Type (Some x, None) -> x = t
 |Type (Some x, Some x') -> x = t && x' = t'
 |Extension suff -> Filename.check_suffix url suff
 in
 match choice_list with
 |Compress_only l -> List.exists check l
 |All_but l -> List.for_all (fun c -> not (check c)) l

(* Pas de filtre global pour l'instant
let choice_list = ref (All_but [])
*)

(** Compression *)

let buffer_size = ref 1024

(*  0 = no compression ; 1 = best speed ; 9 = best compression *)
let compress_level = ref 6

(* Minimal header, by <NAME> *)
let gzip_header_length = 10
let gzip_header = String.make gzip_header_length (Char.chr 0)
let () =
  gzip_header.[0] <- Char.chr 0x1F;
  gzip_header.[1] <- Char.chr 0x8B;
  gzip_header.[2] <- Char.chr 8;
  gzip_header.[9] <- Char.chr 0xFF


(* inspired by an auxiliary function from camlzip, by <NAME> *)
type output_buffer =
  {
  stream: Zlib.stream;
  buf: string;
  mutable pos: int;
  mutable avail: int;
  }

(* puts in oz the content of buf, from pos to pos + len ;
 * f is the continuation of the current stream *)
let rec output oz f buf pos len  =
   if pos < 0 || len < 0 || pos + len > String.length buf then
           assert false ;
  if len = 0 then next_cont oz f else
  if oz.avail = 0 then
    (let cont () = output oz f buf pos len in
    Ocsigen_messages.debug2 "--Deflatemod: Flushing because output buffer is full";
    flush oz cont)
  else (
  (catch
      (fun () ->
        (try return(Zlib.deflate oz.stream buf pos len
                                 oz.buf oz.pos oz.avail
                                 Zlib.Z_SYNC_FLUSH)
            with e -> fail e))
      (function
         |Zlib.Error(s, s') ->
                fail (Ocsigen_stream.Stream_error("Error during compression: "^s^" "^s'))
         | e -> fail e)) >>=
  (fun  (_, used_in, used_out) ->
  oz.pos <- oz.pos + used_out;
  oz.avail <- oz.avail - used_out;
  (* If we didn't deflate the whole input or if the buffer is full, continue *)
  if (used_in < len) || (oz.avail = 0)
  then output oz f buf (pos + used_in) (len - used_in)
  (* otherwise, go to the next part of the stream *)
  else
    next_cont oz f
  ))

(* Flush oz, ie. produces a new_stream with the content of oz, cleans it
 * and returns the continuation of the stream *)
and flush oz cont =
        let len = oz.pos in
        let s = String.sub oz.buf 0 len in
        Ocsigen_messages.debug2 "--Deflatemod: Flushing!";
        oz.pos <- 0 ;
        oz.avail <- String.length oz.buf ;
        if len > 0 then Ocsigen_stream.cont s cont else cont ()

and next_cont oz stream =
  Ocsigen_stream.next stream >>= fun e ->
  match e with
  | Ocsigen_stream.Finished None ->
      Ocsigen_messages.debug2 "--Deflatemod: End of stream: big cleaning for zlib" ;

      (* loop until there is nothing left to compress and flush *)
      let rec after_flushing () =
        (* buffer full *)
        if oz.avail = 0 then flush oz after_flushing
        else (
        (* no more input, deflates only what were left because output buffer
         * was full *)
        let (finished, _, used_out) =
         Zlib.deflate oz.stream oz.buf 0 0 oz.buf oz.pos oz.avail Zlib.Z_FINISH
        in
        oz.pos <- oz.pos + used_out;
        oz.avail <- oz.avail - used_out;
        if not finished then
            after_flushing ()
        else
            (Zlib.deflate_end oz.stream ;
            Ocsigen_messages.debug2 "--Deflatemod: Zlib stream closed, last flush" ;
            flush oz (fun () -> Ocsigen_stream.empty None))) in

      flush oz after_flushing
  | Ocsigen_stream.Finished (Some s) -> next_cont oz s
  | Ocsigen_stream.Cont(s,f) ->
      output oz f s 0 (String.length s)

(* deflate param : true = deflate ; false = gzip (no header in this case) *)
let compress deflate stream =
  let finalize () = Ocsigen_stream.finalize stream in
  let new_stream () =
    let oz =
      { stream = Zlib.deflate_init !compress_level deflate ;
        buf=String.create !buffer_size;
        pos = 0;
        avail = !buffer_size
      } in
    Ocsigen_messages.debug2 "--Deflatemod: Zlib initialized";
    next_cont oz (Ocsigen_stream.get stream) in
  if deflate then
    Ocsigen_stream.make ~finalize new_stream
  else
    Ocsigen_stream.make
      ~finalize (fun () -> Ocsigen_stream.cont gzip_header new_stream)
<commit_msg>Fix memory leak in deflatemod (even when the connection is broken prematurely)<commit_after>(* Ocsigen
 * http://www.ocsigen.org
 * Module deflatemod.ml
 * Copyright (C) 2007 <NAME>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 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 Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)
(*****************************************************************************)
(*****************************************************************************)
(* This module allows to compress output sent by the server                  *)
(*****************************************************************************)
(*****************************************************************************)

open Lwt
open Ocsigen_extensions
open Simplexmlparser
open Ocsigen_headers


(* Content-type *)
type filter = Type of string option * string option | Extension of string
type compress_choice = All_but of filter list |
                       Compress_only of filter list

let should_compress (t, t') url choice_list =
 let check = function
 |Type (None, None) -> true
 |Type (None, Some x') -> x' = t'
 |Type (Some x, None) -> x = t
 |Type (Some x, Some x') -> x = t && x' = t'
 |Extension suff -> Filename.check_suffix url suff
 in
 match choice_list with
 |Compress_only l -> List.exists check l
 |All_but l -> List.for_all (fun c -> not (check c)) l

(* Pas de filtre global pour l'instant
let choice_list = ref (All_but [])
*)

(** Compression *)

let buffer_size = ref 1024

(*  0 = no compression ; 1 = best speed ; 9 = best compression *)
let compress_level = ref 6

(* Minimal header, by <NAME> *)
let gzip_header_length = 10
let gzip_header = String.make gzip_header_length (Char.chr 0)
let () =
  gzip_header.[0] <- Char.chr 0x1F;
  gzip_header.[1] <- Char.chr 0x8B;
  gzip_header.[2] <- Char.chr 8;
  gzip_header.[9] <- Char.chr 0xFF


(* inspired by an auxiliary function from camlzip, by <NAME> *)
type output_buffer =
  {
  stream: Zlib.stream;
  buf: string;
  mutable pos: int;
  mutable avail: int;
  }

(* puts in oz the content of buf, from pos to pos + len ;
 * f is the continuation of the current stream *)
let rec output oz f buf pos len  =
   if pos < 0 || len < 0 || pos + len > String.length buf then
           assert false ;
  if len = 0 then next_cont oz f else
  if oz.avail = 0 then
    (let cont () = output oz f buf pos len in
    Ocsigen_messages.debug2 "--Deflatemod: Flushing because output buffer is full";
    flush oz cont)
  else (
  (catch
      (fun () ->
        (try return(Zlib.deflate oz.stream buf pos len
                                 oz.buf oz.pos oz.avail
                                 Zlib.Z_SYNC_FLUSH)
            with e -> fail e))
      (function
         |Zlib.Error(s, s') ->
                fail (Ocsigen_stream.Stream_error("Error during compression: "^s^" "^s'))
         | e -> fail e)) >>=
  (fun  (_, used_in, used_out) ->
  oz.pos <- oz.pos + used_out;
  oz.avail <- oz.avail - used_out;
  (* If we didn't deflate the whole input or if the buffer is full, continue *)
  if (used_in < len) || (oz.avail = 0)
  then output oz f buf (pos + used_in) (len - used_in)
  (* otherwise, go to the next part of the stream *)
  else
    next_cont oz f
  ))

(* Flush oz, ie. produces a new_stream with the content of oz, cleans it
 * and returns the continuation of the stream *)
and flush oz cont =
        let len = oz.pos in
        let s = String.sub oz.buf 0 len in
        Ocsigen_messages.debug2 "--Deflatemod: Flushing!";
        oz.pos <- 0 ;
        oz.avail <- String.length oz.buf ;
        if len > 0 then Ocsigen_stream.cont s cont else cont ()

and next_cont oz stream =
  Ocsigen_stream.next stream >>= fun e ->
  match e with
  | Ocsigen_stream.Finished None ->
      Ocsigen_messages.debug2 "--Deflatemod: End of stream: big cleaning for zlib" ;

      (* loop until there is nothing left to compress and flush *)
      let rec after_flushing () =
        (* buffer full *)
        if oz.avail = 0 then flush oz after_flushing
        else (
        (* no more input, deflates only what were left because output buffer
         * was full *)
        let (finished, _, used_out) =
         Zlib.deflate oz.stream oz.buf 0 0 oz.buf oz.pos oz.avail Zlib.Z_FINISH
        in
        oz.pos <- oz.pos + used_out;
        oz.avail <- oz.avail - used_out;
        if not finished then
            after_flushing ()
        else
            (Ocsigen_messages.debug2 "--Deflatemod: Zlib.deflate finished, last flush" ;
            flush oz (fun () -> Ocsigen_stream.empty None))) in

      flush oz after_flushing
  | Ocsigen_stream.Finished (Some s) -> next_cont oz s
  | Ocsigen_stream.Cont(s,f) ->
      output oz f s 0 (String.length s)

(* deflate param : true = deflate ; false = gzip (no header in this case) *)
let compress deflate stream =
  let zstream = Zlib.deflate_init !compress_level deflate in
  let finalize () =
    Ocsigen_stream.finalize stream >>= fun e ->
    (try
      Zlib.deflate_end zstream
    with
      (* ignore errors, deflate_end cleans everything anyway *)
      Zlib.Error _ -> ());
    return (Ocsigen_messages.debug2 "--Deflatemod: Zlib stream closed") in
  let oz =
    { stream = zstream ;
      buf = String.create !buffer_size;
      pos = 0;
      avail = !buffer_size
    } in
  let new_stream () = next_cont oz (Ocsigen_stream.get stream) in
  Ocsigen_messages.debug2 "--Deflatemod: Zlib stream initialized" ;
  if deflate then
    Ocsigen_stream.make ~finalize new_stream
  else
    Ocsigen_stream.make
      ~finalize (fun () -> Ocsigen_stream.cont gzip_header new_stream)

{'fraction_non_alphanumeric': 0.1432904336421018, 'fraction_numerical': 0.009754897942454299, 'mean_word_length': 2.7782595230721587, 'pattern_counts': {'":': 0, '<': 35, '<?xml version=': 0, '>': 63, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 2}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5797340', 'n_tokens_mistral': 3791, 'n_tokens_neox': 3611, 'n_words': 1383}