@@ -739,3 +739,159 @@ let local_return_taint =
739739 Part (Features.ReturnAccessPathSet. Element , [] );
740740 Part (Features.SimpleSet. Self , Features.SimpleSet. empty);
741741 ]
742+
743+
744+ module Sanitize = struct
745+ type sanitize_sources =
746+ | AllSources
747+ | SpecificSources of Sources.Set .t
748+ [@@ deriving show , eq ]
749+
750+ type sanitize_sinks =
751+ | AllSinks
752+ | SpecificSinks of Sinks.Set .t
753+ [@@ deriving show , eq ]
754+
755+ type sanitize_tito =
756+ | AllTito
757+ | SpecificTito of {
758+ sanitized_tito_sources : Sources.Set .t ;
759+ sanitized_tito_sinks : Sinks.Set .t ;
760+ }
761+ [@@ deriving show , eq ]
762+
763+ type sanitize = {
764+ sources : sanitize_sources option ;
765+ sinks : sanitize_sinks option ;
766+ tito : sanitize_tito option ;
767+ }
768+ [@@ deriving show , eq ]
769+
770+ include Abstract.SimpleDomain. Make (struct
771+ type t = sanitize
772+
773+ let name = " sanitize"
774+
775+ let bottom = { sources = None ; sinks = None ; tito = None }
776+
777+ let less_or_equal ~left ~right =
778+ if phys_equal left right then
779+ true
780+ else
781+ (match left.sources, right.sources with
782+ | None , _ -> true
783+ | Some _ , None -> false
784+ | Some AllSources , Some AllSources -> true
785+ | Some AllSources , Some (SpecificSources _ ) -> false
786+ | Some (SpecificSources _ ), Some AllSources -> true
787+ | Some (SpecificSources left ), Some (SpecificSources right ) -> Sources.Set. subset left right)
788+ && (match left.sinks, right.sinks with
789+ | None , _ -> true
790+ | Some _ , None -> false
791+ | Some AllSinks , Some AllSinks -> true
792+ | Some AllSinks , Some (SpecificSinks _ ) -> false
793+ | Some (SpecificSinks _ ), Some AllSinks -> true
794+ | Some (SpecificSinks left ), Some (SpecificSinks right ) -> Sinks.Set. subset left right)
795+ &&
796+ match left.tito, right.tito with
797+ | None , _ -> true
798+ | Some _ , None -> false
799+ | Some AllTito , Some AllTito -> true
800+ | Some AllTito , Some (SpecificTito _ ) -> false
801+ | Some (SpecificTito _ ), Some AllTito -> true
802+ | Some (SpecificTito left ), Some (SpecificTito right ) ->
803+ Sources.Set. subset left.sanitized_tito_sources right.sanitized_tito_sources
804+ && Sinks.Set. subset left.sanitized_tito_sinks right.sanitized_tito_sinks
805+
806+
807+ let join left right =
808+ if phys_equal left right then
809+ left
810+ else
811+ let sources =
812+ match left.sources, right.sources with
813+ | None , Some _ -> right.sources
814+ | Some _ , None -> left.sources
815+ | Some AllSources , _
816+ | _ , Some AllSources ->
817+ Some AllSources
818+ | Some (SpecificSources left_sources ), Some (SpecificSources right_sources ) ->
819+ Some (SpecificSources (Sources.Set. union left_sources right_sources))
820+ | None , None -> None
821+ in
822+ let sinks =
823+ match left.sinks, right.sinks with
824+ | None , Some _ -> right.sinks
825+ | Some _ , None -> left.sinks
826+ | Some AllSinks , _
827+ | _ , Some AllSinks ->
828+ Some AllSinks
829+ | Some (SpecificSinks left_sinks ), Some (SpecificSinks right_sinks ) ->
830+ Some (SpecificSinks (Sinks.Set. union left_sinks right_sinks))
831+ | None , None -> None
832+ in
833+ let tito =
834+ match left.tito, right.tito with
835+ | None , Some tito
836+ | Some tito , None ->
837+ Some tito
838+ | Some AllTito , _
839+ | _ , Some AllTito ->
840+ Some AllTito
841+ | Some (SpecificTito left ), Some (SpecificTito right ) ->
842+ Some
843+ (SpecificTito
844+ {
845+ sanitized_tito_sources =
846+ Sources.Set. union left.sanitized_tito_sources right.sanitized_tito_sources;
847+ sanitized_tito_sinks =
848+ Sinks.Set. union left.sanitized_tito_sinks right.sanitized_tito_sinks;
849+ })
850+ | None , None -> None
851+ in
852+ { sources; sinks; tito }
853+
854+
855+ let meet a b = if less_or_equal ~left: b ~right: a then b else a
856+
857+ let show = show_sanitize
858+ end )
859+
860+ let empty = bottom
861+
862+ let is_empty = is_bottom
863+
864+ let equal = equal_sanitize
865+
866+ let to_json { sources; sinks; tito } =
867+ let to_string name = `String name in
868+ let sources_to_json sources =
869+ `List (sources |> Sources.Set. elements |> List. map ~f: Sources. show |> List. map ~f: to_string)
870+ in
871+ let sinks_to_json sinks =
872+ `List (sinks |> Sinks.Set. elements |> List. map ~f: Sinks. show |> List. map ~f: to_string)
873+ in
874+ let sources_json =
875+ match sources with
876+ | Some AllSources -> [" sources" `String " All"
877+ | Some (SpecificSources sources ) -> [" sources"
878+ | None -> []
879+ in
880+ let sinks_json =
881+ match sinks with
882+ | Some AllSinks -> [" sinks" `String " All"
883+ | Some (SpecificSinks sinks ) -> [" sinks"
884+ | None -> []
885+ in
886+ let tito_json =
887+ match tito with
888+ | Some AllTito -> [" tito" `String " All"
889+ | Some (SpecificTito { sanitized_tito_sources; sanitized_tito_sinks } ) ->
890+ [
891+ " tito_sources"
892+ " tito_sinks"
893+ ]
894+ | None -> []
895+ in
896+ `Assoc (sources_json @ sinks_json @ tito_json)
897+ end
0 commit comments