IMAP in OCaml

RFC 9208 - IMAP QUOTA Extension Implementation Plan#

This document provides a detailed implementation plan for adding RFC 9208 (IMAP QUOTA Extension) support to the ocaml-imap library.

RFC Summary#

RFC 9208 (March 2022) defines the IMAP QUOTA extension, which permits administrative limits on resource usage to be manipulated through the IMAP protocol. It obsoletes RFC 2087 while maintaining backward compatibility.

Key RFC References#

  • Full specification: RFC 9208
  • Section 4.1 - Commands (GETQUOTA, GETQUOTAROOT, SETQUOTA)
  • Section 4.2 - Responses (QUOTA, QUOTAROOT)
  • Section 4.3 - Response Codes (OVERQUOTA)
  • Section 5 - Resource Type Definitions
  • Section 7 - Formal Syntax

RFC Requirements#

Commands#

GETQUOTA (Section 4.1.1)#

Arguments:  quota root

Responses:  REQUIRED untagged responses: QUOTA

Result:     OK - getquota completed
            NO - getquota error: no such quota root, permission denied
            BAD - command unknown or arguments invalid

Example:

C: G0001 GETQUOTA "!partition/sda4"
S: * QUOTA "!partition/sda4" (STORAGE 104 10923847)
S: G0001 OK Getquota complete

GETQUOTAROOT (Section 4.1.2)#

Arguments:  mailbox name

Responses:  REQUIRED untagged responses: QUOTAROOT, QUOTA

Result:     OK - getquotaroot completed
            NO - getquotaroot error: permission denied
            BAD - command unknown or arguments invalid

Example:

C: G0002 GETQUOTAROOT INBOX
S: * QUOTAROOT INBOX "#user/alice" "!partition/sda4"
S: * QUOTA "#user/alice" (MESSAGE 42 1000)
S: * QUOTA "!partition/sda4" (STORAGE 104 10923847)
S: G0002 OK Getquotaroot complete

SETQUOTA (Section 4.1.3)#

Arguments:  quota root, list of resource limits

Responses:  untagged responses: QUOTA

Result:     OK - setquota completed
            NO - setquota error: can't set that data
            BAD - command unknown or arguments invalid

Note: Requires "QUOTASET" capability to be advertised.

Example:

C: S0001 SETQUOTA "#user/alice" (STORAGE 510)
S: * QUOTA "#user/alice" (STORAGE 58 512)
S: S0001 OK Rounded quota

New STATUS Attributes (Section 4.1.4)#

Attribute Description Required When
DELETED Number of messages with \Deleted flag QUOTA=RES-MESSAGE capability
DELETED-STORAGE Storage reclaimable by EXPUNGE QUOTA=RES-STORAGE capability

Responses#

QUOTA Response (Section 4.2.1)#

Data: quota root name
      list of resource names, usages, and limits

Format: * QUOTA <quota-root> (<resource> <usage> <limit> ...)

QUOTAROOT Response (Section 4.2.2)#

Data: mailbox name
      zero or more quota root names

Format: * QUOTAROOT <mailbox> [<quota-root> ...]

Response Codes#

OVERQUOTA (Section 4.3.1)#

The OVERQUOTA response code SHOULD be returned in:

  • Tagged NO response to APPEND/COPY/MOVE when quota exceeded
  • Untagged NO response when soft quota exceeded

Note: Code_overquota already exists in protocol.ml (line 257).

Resource Types (Section 5)#

Resource Capability Description Unit
STORAGE QUOTA=RES-STORAGE Physical space estimate 1024 octets (KB)
MESSAGE QUOTA=RES-MESSAGE Number of messages Count
MAILBOX QUOTA=RES-MAILBOX Number of mailboxes Count
ANNOTATION-STORAGE QUOTA=RES-ANNOTATION-STORAGE Annotation size 1024 octets (KB)

Capability Strings#

  • QUOTA - Basic quota support (RFC 2087 compatible)
  • QUOTA=RES-STORAGE - STORAGE resource type support
  • QUOTA=RES-MESSAGE - MESSAGE resource type support
  • QUOTA=RES-MAILBOX - MAILBOX resource type support
  • QUOTA=RES-ANNOTATION-STORAGE - ANNOTATION-STORAGE resource type support
  • QUOTASET - SETQUOTA command support

Current Implementation Status#

Already Implemented#

  • Code_overquota response code in protocol.ml (line 257)
  • Storage.Quota_exceeded error variant in storage.ml (line 19)
  • OVERQUOTA serialization in parser.ml (line 159)

Not Implemented#

  • GETQUOTA command
  • GETQUOTAROOT command
  • SETQUOTA command
  • QUOTA response
  • QUOTAROOT response
  • Resource type definitions
  • Quota tracking in storage backends
  • DELETED and DELETED-STORAGE STATUS attributes
  • QUOTA capabilities

Implementation Tasks#

Priority 1: Core Types and Protocol (Effort: Low)#

Task 1.1: Add Quota Types to Protocol#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/protocol.ml

(** {1 QUOTA Types}

    See {{:https://datatracker.ietf.org/doc/html/rfc9208}RFC 9208}. *)

(** Quota resource types.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-5}RFC 9208 Section 5}. *)
type quota_resource =
  | Quota_storage           (** STORAGE - physical space in KB *)
  | Quota_message           (** MESSAGE - number of messages *)
  | Quota_mailbox           (** MAILBOX - number of mailboxes *)
  | Quota_annotation_storage (** ANNOTATION-STORAGE - annotation size in KB *)

(** A single quota resource with usage and limit.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.2.1}RFC 9208 Section 4.2.1}. *)
type quota_resource_info = {
  resource : quota_resource;
  usage : int64;    (** Current usage (63-bit unsigned) *)
  limit : int64;    (** Resource limit (63-bit unsigned) *)
}

(** Quota root information.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-3.2}RFC 9208 Section 3.2}. *)
type quota_root = string

Task 1.2: Add Quota Commands to Protocol#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/protocol.ml

Add to the command type:

| Getquota of quota_root
    (** {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.1}RFC 9208 Section 4.1.1} *)
| Getquotaroot of mailbox_name
    (** {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.2}RFC 9208 Section 4.1.2} *)
| Setquota of { root : quota_root; limits : (quota_resource * int64) list }
    (** {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.3}RFC 9208 Section 4.1.3} *)

Task 1.3: Add Quota Responses to Protocol#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/protocol.ml

Add to the response type:

| Quota_response of { root : quota_root; resources : quota_resource_info list }
    (** {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.2.1}RFC 9208 Section 4.2.1} *)
| Quotaroot_response of { mailbox : mailbox_name; roots : quota_root list }
    (** {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.2.2}RFC 9208 Section 4.2.2} *)

Task 1.4: Add New STATUS Items#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/protocol.ml

Add to the status_item type:

| Status_deleted_storage
    (** DELETED-STORAGE - storage reclaimable by EXPUNGE.
        {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.4}RFC 9208 Section 4.1.4} *)

Note: Status_deleted already exists for RFC 9051 compliance.

Priority 2: Storage Backend Interface (Effort: Medium)#

Task 2.1: Add Quota Operations to Storage Signature#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/storage.mli

Add to module type STORAGE:

(** {2 Quota Operations}

    See {{:https://datatracker.ietf.org/doc/html/rfc9208}RFC 9208}. *)

val get_quota_roots : t -> username:string -> mailbox_name -> quota_root list
(** Get quota roots for a mailbox.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.2}RFC 9208 Section 4.1.2}. *)

val get_quota : t -> username:string -> quota_root -> (quota_resource_info list, error) result
(** Get quota information for a quota root.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.1}RFC 9208 Section 4.1.1}. *)

val set_quota : t -> username:string -> quota_root -> (quota_resource * int64) list -> (quota_resource_info list, error) result
(** Set quota limits for a quota root.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.3}RFC 9208 Section 4.1.3}.
    Returns the actual limits after any server-side rounding. *)

val check_quota : t -> username:string -> mailbox_name -> additional_size:int64 -> bool
(** Check if an operation would exceed quota.
    Used before APPEND/COPY/MOVE operations. *)

Task 2.2: Add Quota Error Variants#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/storage.ml

Add to type error:

| Quota_root_not_found
| Quota_cannot_set  (** Cannot modify this quota (system limit) *)

Task 2.3: Implement Memory Storage Quota#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/storage.ml

Add to Memory_storage:

(* Quota state per user *)
type user_quota = {
  mutable storage_limit : int64 option;  (* KB *)
  mutable message_limit : int64 option;
  mutable mailbox_limit : int64 option;
}

(* In user_data type *)
type user_data = {
  mailboxes : (mailbox_name, mailbox) Hashtbl.t;
  subscriptions : mailbox_name list;
  quota : user_quota;
}

(* Quota root is "#user/<username>" for per-user quotas *)
let get_quota_roots _t ~username mailbox =
  if Hashtbl.mem (get_user t ~username).mailboxes mailbox then
    ["#user/" ^ username]
  else
    []

let calculate_storage_usage t ~username =
  let user = get_user t ~username in
  Hashtbl.fold (fun _ mb acc ->
    List.fold_left (fun acc (m : message) ->
      Int64.add acc (Int64.div (Int64.add m.size 1023L) 1024L)
    ) acc mb.messages
  ) user.mailboxes 0L

let calculate_message_count t ~username =
  let user = get_user t ~username in
  Int64.of_int (Hashtbl.fold (fun _ mb acc ->
    acc + List.length mb.messages
  ) user.mailboxes 0)

let calculate_mailbox_count t ~username =
  let user = get_user t ~username in
  Int64.of_int (Hashtbl.length user.mailboxes)

Task 2.4: Implement Maildir Storage Quota#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/storage.ml

Add to Maildir_storage:

(* Quota can be stored in a .quota file or calculated from filesystem *)
let quota_file_path path = Filename.concat path ".imapd-quota"

(* Calculate actual storage usage by walking the maildir *)
let calculate_storage_usage t ~username =
  let base = user_path t ~username in
  (* Walk all maildirs and sum file sizes *)
  ...

(* For production, consider:
   - Caching quota calculations
   - Using filesystem quotas (statfs)
   - Storing limits in a database *)

Priority 3: Parser and Serializer (Effort: Medium)#

Task 3.1: Add Lexer Tokens#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/lexer.mll

Add keyword recognition:

| "GETQUOTA" -> GETQUOTA
| "GETQUOTAROOT" -> GETQUOTAROOT
| "SETQUOTA" -> SETQUOTA
| "STORAGE" -> STORAGE
| "MESSAGE" -> MESSAGE_RESOURCE
| "MAILBOX" -> MAILBOX_RESOURCE
| "ANNOTATION-STORAGE" -> ANNOTATION_STORAGE

Task 3.2: Add Grammar Rules#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/grammar.mly

quota_command:
  | GETQUOTA astring
      { Getquota $2 }
  | GETQUOTAROOT mailbox
      { Getquotaroot $2 }
  | SETQUOTA astring LPAREN setquota_list RPAREN
      { Setquota { root = $2; limits = $4 } }
  ;

setquota_list:
  | /* empty */ { [] }
  | setquota_resource setquota_list { $1 :: $2 }
  ;

setquota_resource:
  | resource_name NUMBER64 { ($1, $2) }
  ;

resource_name:
  | STORAGE { Quota_storage }
  | MESSAGE_RESOURCE { Quota_message }
  | MAILBOX_RESOURCE { Quota_mailbox }
  | ANNOTATION_STORAGE { Quota_annotation_storage }
  ;

Task 3.3: Add Response Serialization#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/parser.ml

Add to serialize_response:

| Quota_response { root; resources } ->
  write_string f "* QUOTA ";
  write_quoted_string f root;
  write_string f " (";
  List.iteri (fun i { resource; usage; limit } ->
    if i > 0 then write_sp f;
    (match resource with
     | Quota_storage -> write_string f "STORAGE"
     | Quota_message -> write_string f "MESSAGE"
     | Quota_mailbox -> write_string f "MAILBOX"
     | Quota_annotation_storage -> write_string f "ANNOTATION-STORAGE");
    write_sp f;
    write_string f (Int64.to_string usage);
    write_sp f;
    write_string f (Int64.to_string limit)
  ) resources;
  write_char f ')';
  write_crlf f

| Quotaroot_response { mailbox; roots } ->
  write_string f "* QUOTAROOT ";
  write_quoted_string f mailbox;
  List.iter (fun root ->
    write_sp f;
    write_quoted_string f root
  ) roots;
  write_crlf f

Priority 4: Server Command Handlers (Effort: Medium)#

Task 4.1: Add Capability Advertisement#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/server.ml

Update capabilities:

let quota_capabilities = [
  "QUOTA";
  "QUOTA=RES-STORAGE";
  "QUOTA=RES-MESSAGE";
  "QUOTA=RES-MAILBOX";
  (* "QUOTASET";  Add if SETQUOTA is supported *)
]

let base_capabilities_pre_tls = [
  (* existing capabilities *)
] @ quota_capabilities

Task 4.2: Implement GETQUOTA Handler#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/server.ml

(** Handle GETQUOTA command.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.1}RFC 9208 Section 4.1.1}. *)
let handle_getquota t flow tag root state =
  let username = match state with
    | Authenticated { username } -> Some username
    | Selected { username; _ } -> Some username
    | _ -> None
  in
  match username with
  | None ->
    send_response flow (Bad {
      tag = Some tag; code = None;
      text = "Command not valid in this state"
    });
    state
  | Some username ->
    match Storage.get_quota t.storage ~username root with
    | Error Storage_types.Quota_root_not_found ->
      send_response flow (No {
        tag = Some tag; code = Some Code_nonexistent;
        text = "No such quota root"
      });
      state
    | Error _ ->
      send_response flow (No {
        tag = Some tag; code = None;
        text = "GETQUOTA failed"
      });
      state
    | Ok resources ->
      send_response flow (Quota_response { root; resources });
      send_response flow (Ok {
        tag = Some tag; code = None;
        text = "GETQUOTA completed"
      });
      state

Task 4.3: Implement GETQUOTAROOT Handler#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/server.ml

(** Handle GETQUOTAROOT command.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.2}RFC 9208 Section 4.1.2}. *)
let handle_getquotaroot t flow tag mailbox state =
  let username = match state with
    | Authenticated { username } -> Some username
    | Selected { username; _ } -> Some username
    | _ -> None
  in
  match username with
  | None ->
    send_response flow (Bad {
      tag = Some tag; code = None;
      text = "Command not valid in this state"
    });
    state
  | Some username ->
    (* Security: Validate mailbox name *)
    if not (Protocol.is_safe_mailbox_name mailbox) then begin
      send_response flow (No {
        tag = Some tag; code = None;
        text = "Invalid mailbox name"
      });
      state
    end else begin
      let roots = Storage.get_quota_roots t.storage ~username mailbox in
      (* Send QUOTAROOT response *)
      send_response flow (Quotaroot_response { mailbox; roots });
      (* Send QUOTA response for each root *)
      List.iter (fun root ->
        match Storage.get_quota t.storage ~username root with
        | Ok resources ->
          send_response flow (Quota_response { root; resources })
        | Error _ -> ()
      ) roots;
      send_response flow (Ok {
        tag = Some tag; code = None;
        text = "GETQUOTAROOT completed"
      });
      state
    end

Task 4.4: Implement SETQUOTA Handler#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/server.ml

(** Handle SETQUOTA command.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.3}RFC 9208 Section 4.1.3}.
    Requires QUOTASET capability. *)
let handle_setquota t flow tag ~root ~limits state =
  let username = match state with
    | Authenticated { username } -> Some username
    | Selected { username; _ } -> Some username
    | _ -> None
  in
  match username with
  | None ->
    send_response flow (Bad {
      tag = Some tag; code = None;
      text = "Command not valid in this state"
    });
    state
  | Some username ->
    match Storage.set_quota t.storage ~username root limits with
    | Error Storage_types.Quota_root_not_found ->
      send_response flow (No {
        tag = Some tag; code = Some Code_nonexistent;
        text = "No such quota root"
      });
      state
    | Error Storage_types.Quota_cannot_set ->
      send_response flow (No {
        tag = Some tag; code = Some Code_cannot;
        text = "Cannot change system limit"
      });
      state
    | Error _ ->
      send_response flow (No {
        tag = Some tag; code = None;
        text = "SETQUOTA failed"
      });
      state
    | Ok resources ->
      send_response flow (Quota_response { root; resources });
      send_response flow (Ok {
        tag = Some tag; code = None;
        text = "SETQUOTA completed"
      });
      state

Task 4.5: Add Quota Checks to APPEND/COPY/MOVE#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/lib/imapd/server.ml

Update handle_append:

let handle_append t flow tag ~mailbox ~flags ~date ~message state =
  (* ... existing validation ... *)
  (* Check quota before appending *)
  let message_size = Int64.of_int (String.length message) in
  if not (Storage.check_quota t.storage ~username ~mailbox ~additional_size:message_size) then begin
    send_response flow (No {
      tag = Some tag;
      code = Some Code_overquota;
      text = "APPEND failed: quota exceeded"
    });
    state
  end else
    (* ... existing append logic ... *)

Similar changes needed for handle_copy and handle_move.

Priority 5: Testing (Effort: Medium)#

Task 5.1: Unit Tests for Quota Types#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/test/test_quota.ml

let test_quota_resource_string () =
  Alcotest.(check string) "STORAGE" "STORAGE"
    (quota_resource_to_string Quota_storage);
  Alcotest.(check string) "MESSAGE" "MESSAGE"
    (quota_resource_to_string Quota_message)

let test_quota_response_format () =
  let resp = Quota_response {
    root = "#user/alice";
    resources = [
      { resource = Quota_storage; usage = 104L; limit = 10923847L };
      { resource = Quota_message; usage = 42L; limit = 1000L };
    ]
  } in
  let expected = "* QUOTA \"#user/alice\" (STORAGE 104 10923847 MESSAGE 42 1000)\r\n" in
  Alcotest.(check string) "quota response" expected (response_to_string resp)

Task 5.2: Integration Tests#

File: /Users/avsm/src/git/tangled/anil/mono/ocaml-imap/test/test_server.ml

let test_getquotaroot () =
  (* Setup *)
  let storage = Memory_storage.create () in
  Memory_storage.add_test_user storage ~username:"alice";
  (* Test GETQUOTAROOT command *)
  let cmd = { tag = "Q001"; command = Getquotaroot "INBOX" } in
  (* Verify QUOTAROOT and QUOTA responses *)
  ...

let test_quota_exceeded () =
  (* Setup with low quota *)
  let storage = Memory_storage.create () in
  Memory_storage.add_test_user storage ~username:"alice";
  Memory_storage.set_quota storage ~username:"alice" ~storage_limit:(Some 1L);
  (* Test APPEND when over quota *)
  let large_message = String.make 2048 'X' in
  let cmd = Append { mailbox = "INBOX"; flags = []; date = None; message = large_message } in
  (* Verify OVERQUOTA response *)
  ...

OCamldoc Citation Templates#

Use these templates when documenting quota-related code:

Module-level documentation#

(** IMAP QUOTA Extension

    Implements {{:https://datatracker.ietf.org/doc/html/rfc9208}RFC 9208} for
    managing administrative limits on resource usage through the IMAP protocol.

    {2 References}
    {ul
    {- {{:https://datatracker.ietf.org/doc/html/rfc9208}RFC 9208} - IMAP QUOTA Extension}
    {- {{:https://datatracker.ietf.org/doc/html/rfc9208#section-5}RFC 9208 Section 5} - Resource Type Definitions}
    {- {{:https://datatracker.ietf.org/doc/html/rfc9208#section-7}RFC 9208 Section 7} - Formal Syntax}} *)

Type documentation#

(** Quota resource type.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-5}RFC 9208 Section 5}. *)
type quota_resource = ...

(** Quota root name.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-3.2}RFC 9208 Section 3.2}. *)
type quota_root = string

Function documentation#

(** Get quota information for a quota root.
    See {{:https://datatracker.ietf.org/doc/html/rfc9208#section-4.1.1}RFC 9208 Section 4.1.1}.

    @param root The quota root name
    @return List of resource information or error *)
val get_quota : ...

Implementation Priority Order#

Priority Task Effort Dependencies
P1 1.1-1.4 Protocol types Low None
P2 3.1-3.3 Parser/Serializer Medium P1
P2 2.1-2.2 Storage interface Low P1
P3 2.3 Memory storage quota Medium P2
P3 4.1 Capability advertisement Low P1
P3 4.2-4.4 Command handlers Medium P2
P4 4.5 Quota enforcement Medium P3
P4 2.4 Maildir storage quota High P2
P5 5.1-5.2 Tests Medium P4

File Modification Summary#

File Changes
lib/imapd/protocol.ml Add quota types, commands, responses
lib/imapd/protocol.mli Add quota type signatures
lib/imapd/storage.ml Add quota operations to backends
lib/imapd/storage.mli Add quota signatures to STORAGE
lib/imapd/lexer.mll Add quota-related tokens
lib/imapd/grammar.mly Add quota command grammar
lib/imapd/parser.ml Add quota response serialization
lib/imapd/server.ml Add command handlers, capabilities
test/test_quota.ml New file for quota tests
test/test_server.ml Add quota integration tests

Open Design Questions#

  1. Quota Root Naming: Should we use #user/<username> for per-user quotas or support hierarchical quota roots?

  2. Maildir Quota Storage: Where should quota limits be stored?

    • Option A: .imapd-quota file in user's maildir
    • Option B: Separate database/file
    • Option C: Use filesystem quotas (via statfs)
  3. QUOTASET Permission: Should all authenticated users be able to set quotas, or only administrators?

  4. Soft vs Hard Quotas: Should we support both soft quotas (warning) and hard quotas (rejection)?

  5. ANNOTATION-STORAGE: Do we plan to implement RFC 5257 (ANNOTATE)? If not, should we still advertise QUOTA=RES-ANNOTATION-STORAGE?

  • RFC 9051 - IMAP4rev2 (core protocol, already implemented)
  • RFC 4314 - IMAP ACL Extension (for quota permission checks)
  • RFC 5257 - ANNOTATE Extension (for ANNOTATION-STORAGE resource)