diff --git a/CHANGES.rst b/CHANGES.rst
index abcc1fa6d4515ed1defda5b493a4f64c0e5a381b..225c0a199d474d323e14a5f216a159e4340948e6 100644
--- a/CHANGES.rst
+++ b/CHANGES.rst
@@ -49,6 +49,14 @@ Node
 
 - Change chain validator event encoding. RPC GET  ``/workers/chain_validators/<chain_id>`` is modified.
 
+- Changed contracts RPC to always return  paginated results, to avoid DoS
+  attacks on large directories:
+
+    - GET ``/chain/<chain_id>/blocks/<block_id>/context/contracts`` now takes
+      an optional offset and lenght argument to paginate the results. If length
+      is not provided, it uses 256. Using a length larger than 256 will make
+      the RPC call fail.
+
 Client
 ------
 
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 5fdd547def0eecd74bd8d58c168fb34d77b336f8..6e5f4775ca86bd35074f36607e34b3ef41e151a0 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -1258,7 +1258,7 @@ module Contract : sig
 
   val must_be_allocated : context -> contract -> unit tzresult Lwt.t
 
-  val list : context -> contract list Lwt.t
+  val list : ?offset:int -> ?length:int -> context -> contract list Lwt.t
 
   val get_manager_key : context -> public_key_hash -> public_key tzresult Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index c037693609be6cdbff429aace20da4dad9861990..7967c930a06db8a8933c93089ef11ca97b2f8c74 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -26,6 +26,26 @@
 
 open Alpha_context
 
+type error += List_length_too_long of int
+
+let max_list_length = 256
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"contract.list_length_too_long"
+    ~title:"List length too long"
+    ~description:"List length too long"
+    ~pp:(fun ppf n ->
+      Format.fprintf
+        ppf
+        "List length is too long: %d. The maximum allowed length is %d."
+        n
+        max_list_length)
+    Data_encoding.(obj1 (req "list_lenght_too_large" int31))
+    (function List_length_too_long n -> Some n | _ -> None)
+    (fun n -> List_length_too_long n)
+
 let custom_root =
   (RPC_path.(open_root / "context" / "contracts")
     : RPC_context.t RPC_path.context)
@@ -145,7 +165,7 @@ module S = struct
       ~output:Script.expr_encoding
       RPC_path.(big_map_root /: Big_map.Id.rpc_arg /: Script_expr_hash.rpc_arg)
 
-  type big_map_get_all_query = {offset : int option; length : int option}
+  type page_query = {offset : int option; length : int option}
 
   let rpc_arg_uint : int RPC_arg.t =
     let int_of_string s =
@@ -164,8 +184,13 @@ module S = struct
       ~construct:string_of_int
       ()
 
-  let big_map_get_all_query : big_map_get_all_query RPC_query.t =
+  let page_query default_length : page_query RPC_query.t =
     let open RPC_query in
+    let length_doc_opt =
+      match default_length with
+      | None -> ""
+      | Some n -> Format.sprintf " If not set, the default is %d" n
+    in
     query (fun offset length -> {offset; length})
     |+ opt_field
          ~descr:
@@ -176,8 +201,8 @@ module S = struct
          (fun t -> t.offset)
     |+ opt_field
          ~descr:
-           "Only retrieve [length] values. Useful in combination with [offset] \
-            for pagination."
+           ("Only retrieve [length] values. Useful in combination with \
+             [offset] for pagination." ^ length_doc_opt)
          "length"
          rpc_arg_uint
          (fun t -> t.length)
@@ -188,7 +213,7 @@ module S = struct
       ~description:
         "Get the (optionally paginated) list of values in a big map. Order of \
          values is unspecified, but is guaranteed to be consistent."
-      ~query:big_map_get_all_query
+      ~query:(page_query None)
       ~output:(list Script.expr_encoding)
       RPC_path.(big_map_root /: Big_map.Id.rpc_arg)
 
@@ -203,7 +228,7 @@ module S = struct
     RPC_service.get_service
       ~description:
         "All existing contracts (including non-empty default contracts)."
-      ~query:RPC_query.empty
+      ~query:(page_query (Some max_list_length))
       ~output:(list Contract.encoding)
       custom_root
 
@@ -254,9 +279,16 @@ module S = struct
   end
 end
 
+let cap_length length =
+  let length = Option.value ~default:max_list_length length in
+  if Compare.Int.(length > max_list_length) then Error length else Ok length
+
 let[@coq_axiom_with_reason "gadt"] register () =
   let open Services_registration in
-  register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ;
+  register0 ~chunked:true S.list (fun ctxt {offset; length} () ->
+      match cap_length length with
+      | Error n -> Lwt.return (error (List_length_too_long n))
+      | Ok length -> Contract.list ?offset ~length ctxt >|= ok) ;
   let register_field ~chunked s f =
     opt_register1 ~chunked s (fun ctxt contract () () ->
         Contract.exists ctxt contract >>=? function
@@ -451,7 +483,8 @@ let[@coq_axiom_with_reason "gadt"] register () =
       >|=? fun (script, _ctxt) -> {balance; delegate; script; counter}) ;
   S.Sapling.register ()
 
-let list ctxt block = RPC_context.make_call0 S.list ctxt block () ()
+let list ctxt ?offset ?length block =
+  RPC_context.make_call0 S.list ctxt block {offset; length} ()
 
 let info ctxt block contract =
   RPC_context.make_call1 S.info ctxt block contract () ()
diff --git a/src/proto_alpha/lib_protocol/contract_services.mli b/src/proto_alpha/lib_protocol/contract_services.mli
index 458dfbe4d6170636173bea4641ad668823851be4..fa66bf98c11d9ed060d89b00762e70e4938397b8 100644
--- a/src/proto_alpha/lib_protocol/contract_services.mli
+++ b/src/proto_alpha/lib_protocol/contract_services.mli
@@ -26,7 +26,12 @@
 
 open Alpha_context
 
-val list : 'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t
+val list :
+  'a #RPC_context.simple ->
+  ?offset:int ->
+  ?length:int ->
+  'a ->
+  Contract.t list shell_tzresult Lwt.t
 
 type info = {
   balance : Tez.t;
diff --git a/src/proto_alpha/lib_protocol/contract_storage.ml b/src/proto_alpha/lib_protocol/contract_storage.ml
index d683a8fd66fbfd9192124ae52eb8728b776ed428..58ff297b176e89c096f1029c803a2ed7c0cf1923 100644
--- a/src/proto_alpha/lib_protocol/contract_storage.ml
+++ b/src/proto_alpha/lib_protocol/contract_storage.ml
@@ -573,7 +573,7 @@ let must_be_allocated c contract =
       | Some pkh -> fail (Empty_implicit_contract pkh)
       | None -> fail (Non_existing_contract contract))
 
-let list c = Storage.Contract.list c
+let list ?offset ?length c = Storage.Contract.list ?offset ?length c
 
 let fresh_contract_from_current_nonce c =
   Raw_context.increment_origination_nonce c >|? fun (c, nonce) ->
diff --git a/src/proto_alpha/lib_protocol/contract_storage.mli b/src/proto_alpha/lib_protocol/contract_storage.mli
index 290eb227aa727ce2efb54dfb006292d7fa1d633f..8600849c5470c37e7e23fba8551ce4df7ea79c9e 100644
--- a/src/proto_alpha/lib_protocol/contract_storage.mli
+++ b/src/proto_alpha/lib_protocol/contract_storage.mli
@@ -70,7 +70,8 @@ val allocated : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
 
 val must_be_allocated : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
 
-val list : Raw_context.t -> Contract_repr.t list Lwt.t
+val list :
+  ?offset:int -> ?length:int -> Raw_context.t -> Contract_repr.t list Lwt.t
 
 val check_counter_increment :
   Raw_context.t -> Signature.Public_key_hash.t -> Z.t -> unit tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli
index ac28bdc722ddd7bd22f4f240fe006e431666eb13..df4625430080896274f338a0806f18e19ab8d809 100644
--- a/src/proto_alpha/lib_protocol/storage.mli
+++ b/src/proto_alpha/lib_protocol/storage.mli
@@ -125,7 +125,8 @@ module Contract : sig
     f:(Contract_repr.t -> 'a -> 'a Lwt.t) ->
     'a Lwt.t
 
-  val list : Raw_context.t -> Contract_repr.t list Lwt.t
+  val list :
+    ?offset:int -> ?length:int -> Raw_context.t -> Contract_repr.t list Lwt.t
 
   (** All the tez possessed by a contract, including rolls and change *)
   module Balance :
@@ -230,7 +231,7 @@ module Big_map : sig
   (** The domain of alive big maps *)
   val fold : Raw_context.t -> init:'a -> f:(id -> 'a -> 'a Lwt.t) -> 'a Lwt.t
 
-  val list : Raw_context.t -> id list Lwt.t
+  val list : ?offset:int -> ?length:int -> Raw_context.t -> id list Lwt.t
 
   val remove : Raw_context.t -> id -> Raw_context.t Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml
index ae6b79a5073d78696d276355cdd9cce7da8889aa..19ec2034b211b2176492e6b418f5440ba0c3680a 100644
--- a/src/proto_alpha/lib_protocol/storage_functors.ml
+++ b/src/proto_alpha/lib_protocol/storage_functors.ml
@@ -632,7 +632,42 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
             | Some path -> f path acc)
         | `Value -> Lwt.return acc)
 
-  let keys t = fold_keys t ~init:[] ~f:(fun i acc -> Lwt.return (i :: acc))
+  let keys ?offset ?length t =
+    if Compare.Int.(I.path_length = 1) then
+      C.list t ?offset ?length [] >|= fun l ->
+      List.fold_left
+        (fun acc (path, tree) ->
+          match C.Tree.kind tree with
+          | `Tree -> (
+              match I.of_path [path] with
+              | None -> assert false
+              | Some path -> path :: acc)
+          | `Value -> acc)
+        []
+        (List.rev l)
+    else
+      fold_keys t ~init:(0, []) ~f:(fun i (n, acc) ->
+          Lwt.return (n + 1, i :: acc))
+      >|= fun (n, keys) ->
+      let offset = Option.value ~default:0 offset in
+      let length = Option.value ~default:max_int length in
+      if Compare.Int.(offset = 0) && Compare.Int.(length >= n) then keys
+      else
+        List.fold_left
+          (fun ((rev_values, offset, length) as acc) i ->
+            if Compare.Int.(length <= 0) then
+              (* Keep going until the end, we have no means of
+                 short-circuiting *)
+              acc
+            else if Compare.Int.(offset > 0) then
+              (* Offset (first element) not reached yet *)
+              let offset = pred offset in
+              (rev_values, offset, length)
+            else (* Nominal case *)
+              (i :: rev_values, 0, pred length))
+          ([], offset, length)
+          keys
+        |> fun (l, _, _) -> List.rev l
 
   let err_missing_key key = Raw_context.storage_error (Missing_key (key, Copy))
 
diff --git a/src/proto_alpha/lib_protocol/storage_sigs.ml b/src/proto_alpha/lib_protocol/storage_sigs.ml
index 7319971f365995ba0dfcf77ceffec3ae4a105029..2923ec37a3008479032030587daf9da1d39285c5 100644
--- a/src/proto_alpha/lib_protocol/storage_sigs.ml
+++ b/src/proto_alpha/lib_protocol/storage_sigs.ml
@@ -361,7 +361,7 @@ module type Indexed_raw_context = sig
 
   val fold_keys : context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
 
-  val keys : context -> key list Lwt.t
+  val keys : ?offset:int -> ?length:int -> context -> key list Lwt.t
 
   val remove : context -> key -> context Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/test/test_storage.ml b/src/proto_alpha/lib_protocol/test/test_storage.ml
index b65ceab189b2e4e3453db3fb37d5991a95026766..4d5e8887621f9993d1ad70692f7ef4307137988c 100644
--- a/src/proto_alpha/lib_protocol/test/test_storage.ml
+++ b/src/proto_alpha/lib_protocol/test/test_storage.ml
@@ -203,6 +203,163 @@ let test_register_indexed_subcontext_2 () =
   in
   must_failwith f_prog error
 
+(** init a context with a few contracts and check that paginated lists
+    work as expected. *)
+
+let init_context n =
+  Context.init n >|= function
+  | Error _ -> Alcotest.fail "cannot init context"
+  | Ok (blk, _) -> blk.context
+
+let init_raw_context ctxt =
+  Raw_context.prepare
+    ~level:0l
+    ~predecessor_timestamp:(Time.Protocol.of_seconds 0L)
+    ~timestamp:(Time.Protocol.of_seconds 0L)
+    ~fitness:[]
+    ctxt
+  >|= function
+  | Ok t -> t
+  | Error _ -> Alcotest.fail "cannot init the context"
+
+let contract_repr =
+  Alcotest.testable Contract_repr.pp (fun x y -> Contract_repr.compare x y = 0)
+
+let get = function None -> Alcotest.fail "get option" | Some e -> e
+
+(** Test:
+
+    This test creates a context with a few contracts and check that
+    paginated contract lists work as expected. *)
+let test_contract_list () =
+  init_context 8 >>= init_raw_context >>= fun t ->
+  Storage.Contract.list t >>= fun contracts ->
+  let check_contract i e =
+    Storage.Contract.list ~offset:i ~length:1 t >|= function
+    | [l] -> Alcotest.check contract_repr (Fmt.strf "test %d-th" i) e l
+    | [] -> Alcotest.fail "expecting at least one entry"
+    | _ -> Alcotest.fail "expecting at most one entry"
+  in
+
+  List.iteri
+    (fun i c -> Fmt.epr "contract %2d: %a\n%!" i Contract_repr.pp c)
+    contracts ;
+  Lwt_list.iteri_s check_contract contracts >>= fun () ->
+  let n_contracts = List.length contracts in
+  Storage.Contract.list ~offset:n_contracts ~length:1 t >>= fun l ->
+  Alcotest.(check int) "off limits" 0 (List.length l) ;
+  Storage.Contract.list ~offset:(n_contracts - 1) ~length:2 t >>= fun l ->
+  Alcotest.(check int) "page limits" 1 (List.length l) ;
+  Storage.Contract.list ~offset:2 ~length:3 t >>= fun l ->
+  let (l1, l2, l3) =
+    match l with
+    | [l1; l2; l3] -> (l1, l2, l3)
+    | _ -> Alcotest.fail "expecting 3 elements"
+  in
+  check_contract 2 l1 >>= fun () ->
+  check_contract 3 l2 >>= fun () ->
+  check_contract 4 l3 >>= fun () -> Lwt.return ()
+
+module Nested_dir = struct
+  module Index = struct
+    type t = string
+
+    let path_length = 2
+
+    let to_path c l =
+      let (`Hex key) = Hex.of_string c in
+      String.sub key 0 2 :: key :: l
+
+    let of_path = function
+      | [_; key] ->
+          let raw_key = Hex.to_string (`Hex key) in
+          Some raw_key
+      | _ -> assert false
+
+    let rpc_arg =
+      Environment.RPC_arg.make
+        ~name:"nested"
+        ~destruct:(fun s -> Ok s)
+        ~construct:(fun x -> x)
+        ()
+
+    let compare = String.compare
+
+    let encoding = Data_encoding.string
+
+    type 'a ipath = 'a * t
+
+    let args = Storage_description.One {rpc_arg; encoding; compare}
+  end
+
+  module C =
+    Make_subcontext (Registered) (Raw_context)
+      (struct
+        let name = ["nested"]
+      end)
+
+  include
+    Make_indexed_subcontext
+      (Make_subcontext (Registered) (C)
+         (struct
+           let name = ["index"]
+         end))
+         (Index)
+
+  let list = keys
+end
+
+let all_entries =
+  match List.init ~when_negative_length:[] 10 string_of_int with
+  | Error _ -> assert false
+  | Ok l -> l
+
+let all_entries_length = List.length all_entries
+
+let init_nested_context () =
+  init_context 1 >>= fun t ->
+  let open Environment_context in
+  Lwt_list.fold_left_s
+    (fun t c ->
+      let key = "nested" :: "index" :: Nested_dir.Index.to_path c ["tree"] in
+      Context.add t key (Bytes.of_string c))
+    t
+    all_entries
+
+(** Test:
+
+    This test creates a fake context with nested directories and check that
+    paginated lists work as expected. *)
+let test_nested_list () =
+  init_nested_context () >>= init_raw_context >>= fun t ->
+  Nested_dir.list t >>= fun entries ->
+  Alcotest.(check int)
+    "all entries are present"
+    all_entries_length
+    (List.length entries) ;
+  let check_entry i e =
+    Nested_dir.list ~offset:i ~length:1 t >|= function
+    | [l] -> Alcotest.(check string) (Fmt.strf "test %d-th" i) e l
+    | [] -> Alcotest.fail "expecting at least one entry"
+    | _ -> Alcotest.fail "expecting at most one entry"
+  in
+
+  List.iteri (fun i c -> Fmt.epr "entry %2d: %S\n%!" i c) entries ;
+  Lwt_list.iteri_s check_entry entries >>= fun () ->
+  Nested_dir.list ~offset:all_entries_length ~length:1 t >>= fun l ->
+  Alcotest.(check int) "off limits" 0 (List.length l) ;
+  Nested_dir.list ~offset:(all_entries_length - 1) ~length:2 t >>= fun l ->
+  Alcotest.(check int) "page limits" 1 (List.length l) ;
+  Nested_dir.list ~offset:2 ~length:3 t >>= fun l ->
+  let (l1, l2, l3) =
+    match l with
+    | [l1; l2; l3] -> (l1, l2, l3)
+    | _ -> Alcotest.fail "expecting 3 elements"
+  in
+  check_entry 2 l1 >>= fun () ->
+  check_entry 3 l2 >>= fun () ->
+  check_entry 4 l3 >>= fun () -> Lwt.return ()
+
 let tests =
   [
     Alcotest_lwt.test_case
@@ -221,4 +378,6 @@ let tests =
       "register indexed subcontext with existing indexed subcontext"
       `Quick
       (fun _ -> test_register_indexed_subcontext_2);
+    Alcotest_lwt.test_case "Contract.list" `Quick (fun _ -> test_contract_list);
+    Alcotest_lwt.test_case "Subcontext.keys" `Quick (fun _ -> test_nested_list);
   ]
diff --git a/tezt/lib_tezos/RPC.ml b/tezt/lib_tezos/RPC.ml
index e6e77c95ca9bd2beaca655acce8a8d0aa60aedab..535dc049171eaca751ed2993b0f8097e7b40518a 100644
--- a/tezt/lib_tezos/RPC.ml
+++ b/tezt/lib_tezos/RPC.ml
@@ -160,6 +160,13 @@ let post_run_operation ?endpoint ?hooks ?(chain = "main") ?(block = "head")
   in
   Client.rpc ?endpoint ?hooks ~data POST path client
 
+let query_page ?offset ?length () =
+  [
+    Option.map (fun offset -> ("offset", Int.to_string offset)) offset;
+    Option.map (fun length -> ("length", Int.to_string length)) length;
+  ]
+  |> List.filter_map Fun.id
+
 module Big_maps = struct
   let get ?endpoint ?hooks ?(chain = "main") ?(block = "head") ~id ~key_hash
       client =
@@ -173,13 +180,7 @@ module Big_maps = struct
     let path =
       ["chains"; chain; "blocks"; block; "context"; "big_maps"; big_map_id]
     in
-    let query_string =
-      [
-        Option.map (fun offset -> ("offset", Int.to_string offset)) offset;
-        Option.map (fun length -> ("length", Int.to_string length)) length;
-      ]
-      |> List.filter_map Fun.id
-    in
+    let query_string = query_page ?offset ?length () in
     Client.spawn_rpc ?endpoint ?hooks ~query_string GET path client
 
   let get_all ?endpoint ?hooks ?(chain = "main") ?(block = "head") ~big_map_id
@@ -207,9 +208,13 @@ module Contracts = struct
     let path = ["chains"; chain; "blocks"; block; "context"; "contracts"] in
     Client.spawn_rpc ?endpoint ?hooks GET path client
 
-  let get_all ?endpoint ?hooks ?(chain = "main") ?(block = "head") client =
+  let get_all ?endpoint ?hooks ?(chain = "main") ?(block = "head") ?offset
+      ?length client =
     let path = ["chains"; chain; "blocks"; block; "context"; "contracts"] in
-    let* contracts = Client.rpc ?endpoint ?hooks GET path client in
+    let query_string = query_page ?offset ?length () in
+    let* contracts =
+      Client.rpc ?endpoint ~query_string ?hooks GET path client
+    in
     return (JSON.as_list contracts |> List.map JSON.as_string)
 
   let get_all_delegates ?endpoint ?hooks ?(chain = "main") ?(block = "head")
diff --git a/tezt/lib_tezos/RPC.mli b/tezt/lib_tezos/RPC.mli
index 0b0a612927204c2e100d254e9edfa2880471b83c..7b2525dbb451f5b1faeba7ae8ca8b2e34ef6c39c 100644
--- a/tezt/lib_tezos/RPC.mli
+++ b/tezt/lib_tezos/RPC.mli
@@ -304,6 +304,8 @@ module Contracts : sig
     ?hooks:Process.hooks ->
     ?chain:string ->
     ?block:string ->
+    ?offset:int ->
+    ?length:int ->
     Client.t ->
     string list Lwt.t