CCSDS File Delivery Protocol (CCSDS 727.0-B-5) for space file transfer
fix(merlint): show file path instead of (global) for E510 issues
Add a location (file:1:0) to E510 Missing Log Source issues so the
output shows the full file path, making it easy to identify which
module needs fixing in monorepos with many similarly-named modules.
Also includes accumulated linter fixes and dune fmt formatting.
+297
-272
+297
-272
lib/cfdp.ml
+297
-272
lib/cfdp.ml
···
667
667
put_u32_be buf 0 (Int64.to_int value);
668
668
Bytes.to_string buf
669
669
670
+
let encode_eof ~large_file eof_pdu =
671
+
let fss = encode_fss ~large_file eof_pdu.file_size in
672
+
let fault_tlv =
673
+
match eof_pdu.fault_location with
674
+
| None -> ""
675
+
| Some eid ->
676
+
let buf = Bytes.create 10 in
677
+
Bytes.set buf 0 (Char.chr 0x06);
678
+
Bytes.set buf 1 (Char.chr 8);
679
+
put_u64_be buf 2 (Entity_id.to_int64 eid);
680
+
Bytes.to_string buf
681
+
in
682
+
let buf = Bytes.create 6 in
683
+
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_eof));
684
+
Bytes.set buf 1 (Char.chr (int_of_condition eof_pdu.condition lsl 4));
685
+
put_u32_be buf 2 (Int32.to_int eof_pdu.checksum);
686
+
Bytes.to_string buf ^ fss ^ fault_tlv
687
+
688
+
let encode_finished fin =
689
+
let buf = Bytes.create 2 in
690
+
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_finished));
691
+
let b1 =
692
+
(int_of_condition fin.condition lsl 4)
693
+
lor (match fin.delivery_code with
694
+
| Data_complete -> 0
695
+
| Data_incomplete -> 1)
696
+
lsl 2
697
+
lor
698
+
match fin.file_status with
699
+
| Discarded_deliberately -> 0
700
+
| Discarded_filestore_rejection -> 1
701
+
| Retained_successfully -> 2
702
+
| Status_unreported -> 3
703
+
in
704
+
Bytes.set buf 1 (Char.chr b1);
705
+
Bytes.to_string buf
706
+
707
+
let encode_ack ack_pdu =
708
+
let buf = Bytes.create 3 in
709
+
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_ack));
710
+
let b1 =
711
+
(int_of_directive_code ack_pdu.directive lsl 4)
712
+
lor (ack_pdu.subtype land 0xF)
713
+
in
714
+
Bytes.set buf 1 (Char.chr b1);
715
+
let b2 =
716
+
(int_of_condition ack_pdu.condition lsl 4)
717
+
lor
718
+
match ack_pdu.transaction_status with
719
+
| Tx_undefined -> 0
720
+
| Tx_active -> 1
721
+
| Tx_terminated -> 2
722
+
| Tx_unrecognized -> 3
723
+
in
724
+
Bytes.set buf 2 (Char.chr b2);
725
+
Bytes.to_string buf
726
+
727
+
let encode_metadata ~large_file meta =
728
+
let buf = Bytes.create 2 in
729
+
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_metadata));
730
+
let b1 =
731
+
((if meta.closure_requested then 1 else 0) lsl 6)
732
+
lor int_of_checksum_type meta.checksum_type
733
+
in
734
+
Bytes.set buf 1 (Char.chr b1);
735
+
let fss = encode_fss ~large_file meta.file_size in
736
+
let src_lv = encode_lv meta.source_filename in
737
+
let dst_lv = encode_lv meta.dest_filename in
738
+
Bytes.to_string buf ^ fss ^ src_lv ^ dst_lv
739
+
740
+
let encode_nak ~large_file nak_pdu =
741
+
let code = Bytes.make 1 (Char.chr (int_of_directive_code Dir_nak)) in
742
+
let start_fss = encode_fss ~large_file nak_pdu.start_scope in
743
+
let end_fss = encode_fss ~large_file nak_pdu.end_scope in
744
+
let segs =
745
+
List.map
746
+
(fun seg ->
747
+
encode_fss ~large_file seg.start_offset
748
+
^ encode_fss ~large_file seg.end_offset)
749
+
nak_pdu.segments
750
+
in
751
+
String.concat "" ([ Bytes.to_string code; start_fss; end_fss ] @ segs)
752
+
753
+
let encode_prompt pmt =
754
+
let buf = Bytes.create 2 in
755
+
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_prompt));
756
+
let b1 =
757
+
match pmt.response with Prompt_nak -> 0 | Prompt_keep_alive -> 0x80
758
+
in
759
+
Bytes.set buf 1 (Char.chr b1);
760
+
Bytes.to_string buf
761
+
762
+
let encode_keep_alive ~large_file ka =
763
+
let code = Bytes.make 1 (Char.chr (int_of_directive_code Dir_keep_alive)) in
764
+
let fss = encode_fss ~large_file ka.progress in
765
+
Bytes.to_string code ^ fss
766
+
670
767
let encode_directive ~large_file dir =
671
768
match dir with
672
-
| Eof eof_pdu ->
673
-
let fss = encode_fss ~large_file eof_pdu.file_size in
674
-
let fault_tlv =
675
-
match eof_pdu.fault_location with
676
-
| None -> ""
677
-
| Some eid ->
678
-
let buf = Bytes.create 10 in
679
-
Bytes.set buf 0 (Char.chr 0x06);
680
-
Bytes.set buf 1 (Char.chr 8);
681
-
put_u64_be buf 2 (Entity_id.to_int64 eid);
682
-
Bytes.to_string buf
683
-
in
684
-
let buf = Bytes.create 6 in
685
-
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_eof));
686
-
Bytes.set buf 1 (Char.chr (int_of_condition eof_pdu.condition lsl 4));
687
-
put_u32_be buf 2 (Int32.to_int eof_pdu.checksum);
688
-
Bytes.to_string buf ^ fss ^ fault_tlv
689
-
| Finished fin ->
690
-
let buf = Bytes.create 2 in
691
-
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_finished));
692
-
let b1 =
693
-
(int_of_condition fin.condition lsl 4)
694
-
lor (match fin.delivery_code with
695
-
| Data_complete -> 0
696
-
| Data_incomplete -> 1)
697
-
lsl 2
698
-
lor
699
-
match fin.file_status with
700
-
| Discarded_deliberately -> 0
701
-
| Discarded_filestore_rejection -> 1
702
-
| Retained_successfully -> 2
703
-
| Status_unreported -> 3
704
-
in
705
-
Bytes.set buf 1 (Char.chr b1);
706
-
Bytes.to_string buf
707
-
| Ack ack_pdu ->
708
-
let buf = Bytes.create 3 in
709
-
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_ack));
710
-
let b1 =
711
-
(int_of_directive_code ack_pdu.directive lsl 4)
712
-
lor (ack_pdu.subtype land 0xF)
713
-
in
714
-
Bytes.set buf 1 (Char.chr b1);
715
-
let b2 =
716
-
(int_of_condition ack_pdu.condition lsl 4)
717
-
lor
718
-
match ack_pdu.transaction_status with
719
-
| Tx_undefined -> 0
720
-
| Tx_active -> 1
721
-
| Tx_terminated -> 2
722
-
| Tx_unrecognized -> 3
723
-
in
724
-
Bytes.set buf 2 (Char.chr b2);
725
-
Bytes.to_string buf
726
-
| Metadata meta ->
727
-
let buf = Bytes.create 2 in
728
-
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_metadata));
729
-
let b1 =
730
-
((if meta.closure_requested then 1 else 0) lsl 6)
731
-
lor int_of_checksum_type meta.checksum_type
732
-
in
733
-
Bytes.set buf 1 (Char.chr b1);
734
-
let fss = encode_fss ~large_file meta.file_size in
735
-
let src_lv = encode_lv meta.source_filename in
736
-
let dst_lv = encode_lv meta.dest_filename in
737
-
Bytes.to_string buf ^ fss ^ src_lv ^ dst_lv
738
-
| Nak nak_pdu ->
739
-
let code = Bytes.make 1 (Char.chr (int_of_directive_code Dir_nak)) in
740
-
let start_fss = encode_fss ~large_file nak_pdu.start_scope in
741
-
let end_fss = encode_fss ~large_file nak_pdu.end_scope in
742
-
let segs =
743
-
List.map
744
-
(fun seg ->
745
-
encode_fss ~large_file seg.start_offset
746
-
^ encode_fss ~large_file seg.end_offset)
747
-
nak_pdu.segments
748
-
in
749
-
String.concat "" ([ Bytes.to_string code; start_fss; end_fss ] @ segs)
750
-
| Prompt pmt ->
751
-
let buf = Bytes.create 2 in
752
-
Bytes.set buf 0 (Char.chr (int_of_directive_code Dir_prompt));
753
-
let b1 =
754
-
match pmt.response with Prompt_nak -> 0 | Prompt_keep_alive -> 0x80
755
-
in
756
-
Bytes.set buf 1 (Char.chr b1);
757
-
Bytes.to_string buf
758
-
| Keep_alive ka ->
759
-
let code =
760
-
Bytes.make 1 (Char.chr (int_of_directive_code Dir_keep_alive))
761
-
in
762
-
let fss = encode_fss ~large_file ka.progress in
763
-
Bytes.to_string code ^ fss
769
+
| Eof eof_pdu -> encode_eof ~large_file eof_pdu
770
+
| Finished fin -> encode_finished fin
771
+
| Ack ack_pdu -> encode_ack ack_pdu
772
+
| Metadata meta -> encode_metadata ~large_file meta
773
+
| Nak nak_pdu -> encode_nak ~large_file nak_pdu
774
+
| Prompt pmt -> encode_prompt pmt
775
+
| Keep_alive ka -> encode_keep_alive ~large_file ka
764
776
765
777
let encode_file_data ~large_file ~segment_metadata:seg_meta_flag fd =
766
778
let seg_meta_bytes =
···
827
839
open Result.Syntax
828
840
829
841
let truncated ~need ~have = Error (Truncated { need; have })
842
+
843
+
let make_header ~version ~pdu_type_bit ~direction_bit ~mode_bit ~crc_bit
844
+
~large_bit ~seg_ctrl_bit ~seg_meta_bit ~source_entity ~transaction_seq
845
+
~dest_entity ~data_len =
846
+
{
847
+
version;
848
+
pdu_type = (if pdu_type_bit = 0 then File_directive else File_data);
849
+
direction = (if direction_bit = 0 then Toward_receiver else Toward_sender);
850
+
transmission_mode = (if mode_bit = 0 then Acknowledged else Unacknowledged);
851
+
crc_present = crc_bit = 1;
852
+
large_file = large_bit = 1;
853
+
segment_ctrl = seg_ctrl_bit = 1;
854
+
segment_metadata = seg_meta_bit = 1;
855
+
source_entity;
856
+
transaction_seq;
857
+
dest_entity;
858
+
data_len;
859
+
}
830
860
831
861
let decode_header buf =
832
862
let len = String.length buf in
···
865
895
| `Overflow -> Error Entity_id_overflow
866
896
in
867
897
let header =
868
-
{
869
-
version;
870
-
pdu_type = (if pdu_type_bit = 0 then File_directive else File_data);
871
-
direction =
872
-
(if direction_bit = 0 then Toward_receiver else Toward_sender);
873
-
transmission_mode =
874
-
(if mode_bit = 0 then Acknowledged else Unacknowledged);
875
-
crc_present = crc_bit = 1;
876
-
large_file = large_bit = 1;
877
-
segment_ctrl = seg_ctrl_bit = 1;
878
-
segment_metadata = seg_meta_bit = 1;
879
-
source_entity;
880
-
transaction_seq;
881
-
dest_entity;
882
-
data_len;
883
-
}
898
+
make_header ~version ~pdu_type_bit ~direction_bit ~mode_bit ~crc_bit
899
+
~large_bit ~seg_ctrl_bit ~seg_meta_bit ~source_entity
900
+
~transaction_seq ~dest_entity ~data_len
884
901
in
885
902
Ok (header, config, 4 + var_len)
886
903
···
900
917
let s = String.sub buf (off + 1) str_len in
901
918
Ok (s, 1 + str_len)
902
919
920
+
let decode_eof ~large_file buf off len =
921
+
let fss_len = if large_file then 8 else 4 in
922
+
let min_len = 1 + 1 + 4 + fss_len in
923
+
if len < min_len then Error (Truncated { need = min_len; have = len })
924
+
else
925
+
let b1 = Char.code buf.[off + 1] in
926
+
let cond_code = (b1 lsr 4) land 0xF in
927
+
match condition_of_int cond_code with
928
+
| None -> Error (Invalid_condition_code cond_code)
929
+
| Some cond ->
930
+
let cksum = Int32.of_int (u32_be buf (off + 2)) in
931
+
let fsize, _ = decode_fss buf (off + 6) ~large_file in
932
+
let fss_end = off + 6 + fss_len in
933
+
(* Parse fault location TLV if present *)
934
+
let floc, consumed =
935
+
if len > fss_end - off && Char.code buf.[fss_end] = 0x06 then begin
936
+
let tlv_len = Char.code buf.[fss_end + 1] in
937
+
if tlv_len = 8 then
938
+
let raw = u64_be buf (fss_end + 2) in
939
+
match Entity_id.of_int64_unsigned raw with
940
+
| `Ok eid -> (Some eid, fss_end + 2 + tlv_len - off)
941
+
| `Overflow -> (None, fss_end - off)
942
+
else (None, fss_end - off)
943
+
end
944
+
else (None, fss_end - off)
945
+
in
946
+
Ok
947
+
( Eof
948
+
{
949
+
condition = cond;
950
+
checksum = cksum;
951
+
file_size = fsize;
952
+
fault_location = floc;
953
+
},
954
+
consumed )
955
+
956
+
let decode_finished buf off len =
957
+
if len < 2 then Error (Truncated { need = 2; have = len })
958
+
else
959
+
let b1 = Char.code buf.[off + 1] in
960
+
let cond_code = (b1 lsr 4) land 0xF in
961
+
match condition_of_int cond_code with
962
+
| None -> Error (Invalid_condition_code cond_code)
963
+
| Some cond ->
964
+
let delivery =
965
+
if (b1 lsr 2) land 0x1 = 0 then Data_complete else Data_incomplete
966
+
in
967
+
let status =
968
+
match b1 land 0x3 with
969
+
| 0 -> Discarded_deliberately
970
+
| 1 -> Discarded_filestore_rejection
971
+
| 2 -> Retained_successfully
972
+
| _ -> Status_unreported
973
+
in
974
+
Ok
975
+
( Finished
976
+
{
977
+
condition = cond;
978
+
delivery_code = delivery;
979
+
file_status = status;
980
+
filestore_responses = [];
981
+
fault_location = None;
982
+
},
983
+
2 )
984
+
985
+
let decode_ack buf off len =
986
+
if len < 3 then Error (Truncated { need = 3; have = len })
987
+
else
988
+
let b1 = Char.code buf.[off + 1] in
989
+
let dir_code = (b1 lsr 4) land 0xF in
990
+
let sub = b1 land 0xF in
991
+
let b2 = Char.code buf.[off + 2] in
992
+
let cond_code = (b2 lsr 4) land 0xF in
993
+
let tx_status = b2 land 0x3 in
994
+
match (directive_code_of_int dir_code, condition_of_int cond_code) with
995
+
| None, _ -> Error (Invalid_directive_code dir_code)
996
+
| _, None -> Error (Invalid_condition_code cond_code)
997
+
| Some dc, Some cond ->
998
+
let status =
999
+
match tx_status with
1000
+
| 0 -> Tx_undefined
1001
+
| 1 -> Tx_active
1002
+
| 2 -> Tx_terminated
1003
+
| _ -> Tx_unrecognized
1004
+
in
1005
+
Ok
1006
+
( Ack
1007
+
{
1008
+
directive = dc;
1009
+
subtype = sub;
1010
+
condition = cond;
1011
+
transaction_status = status;
1012
+
},
1013
+
3 )
1014
+
1015
+
let decode_metadata ~large_file buf off len =
1016
+
let fss_len = if large_file then 8 else 4 in
1017
+
let min_len = 1 + 1 + fss_len + 2 in
1018
+
if len < min_len then Error (Truncated { need = min_len; have = len })
1019
+
else
1020
+
let b1 = Char.code buf.[off + 1] in
1021
+
let closure = (b1 lsr 6) land 0x1 = 1 in
1022
+
let cksum_type = b1 land 0xF in
1023
+
match checksum_type_of_int cksum_type with
1024
+
| None -> Error (Invalid_checksum_type cksum_type)
1025
+
| Some ctype ->
1026
+
let fsize, fss_consumed = decode_fss buf (off + 2) ~large_file in
1027
+
let off2 = off + 2 + fss_consumed in
1028
+
let* src, src_consumed = decode_lv buf off2 in
1029
+
let off3 = off2 + src_consumed in
1030
+
let* dst, dst_consumed = decode_lv buf off3 in
1031
+
let off4 = off3 + dst_consumed in
1032
+
Ok
1033
+
( Metadata
1034
+
{
1035
+
closure_requested = closure;
1036
+
checksum_type = ctype;
1037
+
file_size = fsize;
1038
+
source_filename = src;
1039
+
dest_filename = dst;
1040
+
filestore_requests = [];
1041
+
messages_to_user = [];
1042
+
},
1043
+
off4 - off )
1044
+
1045
+
let decode_nak ~large_file buf off len =
1046
+
let fss_len = if large_file then 8 else 4 in
1047
+
let min_len = 1 + (2 * fss_len) in
1048
+
if len < min_len then Error (Truncated { need = min_len; have = len })
1049
+
else
1050
+
let sscope, _ = decode_fss buf (off + 1) ~large_file in
1051
+
let escope, _ = decode_fss buf (off + 1 + fss_len) ~large_file in
1052
+
let remaining = len - (1 + (2 * fss_len)) in
1053
+
let seg_count = remaining / (2 * fss_len) in
1054
+
let segs = ref [] in
1055
+
let curr_off = ref (off + 1 + (2 * fss_len)) in
1056
+
for _ = 1 to seg_count do
1057
+
let soff, _ = decode_fss buf !curr_off ~large_file in
1058
+
let eoff, _ = decode_fss buf (!curr_off + fss_len) ~large_file in
1059
+
segs := { start_offset = soff; end_offset = eoff } :: !segs;
1060
+
curr_off := !curr_off + (2 * fss_len)
1061
+
done;
1062
+
Ok
1063
+
( Nak
1064
+
{
1065
+
start_scope = sscope;
1066
+
end_scope = escope;
1067
+
segments = List.rev !segs;
1068
+
},
1069
+
!curr_off - off )
1070
+
1071
+
let decode_prompt buf off len =
1072
+
if len < 2 then Error (Truncated { need = 2; have = len })
1073
+
else
1074
+
let b1 = Char.code buf.[off + 1] in
1075
+
let resp = if b1 land 0x80 = 0 then Prompt_nak else Prompt_keep_alive in
1076
+
Ok (Prompt { response = resp }, 2)
1077
+
1078
+
let decode_keep_alive ~large_file buf off len =
1079
+
let fss_len = if large_file then 8 else 4 in
1080
+
if len < 1 + fss_len then Error (Truncated { need = 1 + fss_len; have = len })
1081
+
else
1082
+
let prog, _ = decode_fss buf (off + 1) ~large_file in
1083
+
Ok (Keep_alive { progress = prog }, 1 + fss_len)
1084
+
903
1085
let decode_directive ~large_file buf off =
904
1086
let len = String.length buf - off in
905
1087
if len < 1 then Error (Truncated { need = 1; have = len })
···
907
1089
let code = Char.code buf.[off] in
908
1090
match directive_code_of_int code with
909
1091
| None -> Error (Invalid_directive_code code)
910
-
| Some Dir_eof -> (
911
-
let fss_len = if large_file then 8 else 4 in
912
-
let min_len = 1 + 1 + 4 + fss_len in
913
-
if len < min_len then Error (Truncated { need = min_len; have = len })
914
-
else
915
-
let b1 = Char.code buf.[off + 1] in
916
-
let cond_code = (b1 lsr 4) land 0xF in
917
-
match condition_of_int cond_code with
918
-
| None -> Error (Invalid_condition_code cond_code)
919
-
| Some cond ->
920
-
let cksum = Int32.of_int (u32_be buf (off + 2)) in
921
-
let fsize, _ = decode_fss buf (off + 6) ~large_file in
922
-
let fss_end = off + 6 + fss_len in
923
-
(* Parse fault location TLV if present *)
924
-
let floc, consumed =
925
-
if len > fss_end - off && Char.code buf.[fss_end] = 0x06 then begin
926
-
let tlv_len = Char.code buf.[fss_end + 1] in
927
-
if tlv_len = 8 then
928
-
let raw = u64_be buf (fss_end + 2) in
929
-
match Entity_id.of_int64_unsigned raw with
930
-
| `Ok eid -> (Some eid, fss_end + 2 + tlv_len - off)
931
-
| `Overflow -> (None, fss_end - off)
932
-
else (None, fss_end - off)
933
-
end
934
-
else (None, fss_end - off)
935
-
in
936
-
Ok
937
-
( Eof
938
-
{
939
-
condition = cond;
940
-
checksum = cksum;
941
-
file_size = fsize;
942
-
fault_location = floc;
943
-
},
944
-
consumed ))
945
-
| Some Dir_finished -> (
946
-
if len < 2 then Error (Truncated { need = 2; have = len })
947
-
else
948
-
let b1 = Char.code buf.[off + 1] in
949
-
let cond_code = (b1 lsr 4) land 0xF in
950
-
match condition_of_int cond_code with
951
-
| None -> Error (Invalid_condition_code cond_code)
952
-
| Some cond ->
953
-
let delivery =
954
-
if (b1 lsr 2) land 0x1 = 0 then Data_complete
955
-
else Data_incomplete
956
-
in
957
-
let status =
958
-
match b1 land 0x3 with
959
-
| 0 -> Discarded_deliberately
960
-
| 1 -> Discarded_filestore_rejection
961
-
| 2 -> Retained_successfully
962
-
| _ -> Status_unreported
963
-
in
964
-
Ok
965
-
( Finished
966
-
{
967
-
condition = cond;
968
-
delivery_code = delivery;
969
-
file_status = status;
970
-
filestore_responses = [];
971
-
fault_location = None;
972
-
},
973
-
2 ))
974
-
| Some Dir_ack -> (
975
-
if len < 3 then Error (Truncated { need = 3; have = len })
976
-
else
977
-
let b1 = Char.code buf.[off + 1] in
978
-
let dir_code = (b1 lsr 4) land 0xF in
979
-
let sub = b1 land 0xF in
980
-
let b2 = Char.code buf.[off + 2] in
981
-
let cond_code = (b2 lsr 4) land 0xF in
982
-
let tx_status = b2 land 0x3 in
983
-
match
984
-
(directive_code_of_int dir_code, condition_of_int cond_code)
985
-
with
986
-
| None, _ -> Error (Invalid_directive_code dir_code)
987
-
| _, None -> Error (Invalid_condition_code cond_code)
988
-
| Some dc, Some cond ->
989
-
let status =
990
-
match tx_status with
991
-
| 0 -> Tx_undefined
992
-
| 1 -> Tx_active
993
-
| 2 -> Tx_terminated
994
-
| _ -> Tx_unrecognized
995
-
in
996
-
Ok
997
-
( Ack
998
-
{
999
-
directive = dc;
1000
-
subtype = sub;
1001
-
condition = cond;
1002
-
transaction_status = status;
1003
-
},
1004
-
3 ))
1005
-
| Some Dir_metadata -> (
1006
-
let fss_len = if large_file then 8 else 4 in
1007
-
let min_len = 1 + 1 + fss_len + 2 in
1008
-
if len < min_len then Error (Truncated { need = min_len; have = len })
1009
-
else
1010
-
let b1 = Char.code buf.[off + 1] in
1011
-
let closure = (b1 lsr 6) land 0x1 = 1 in
1012
-
let cksum_type = b1 land 0xF in
1013
-
match checksum_type_of_int cksum_type with
1014
-
| None -> Error (Invalid_checksum_type cksum_type)
1015
-
| Some ctype ->
1016
-
let fsize, fss_consumed = decode_fss buf (off + 2) ~large_file in
1017
-
let off2 = off + 2 + fss_consumed in
1018
-
let* src, src_consumed = decode_lv buf off2 in
1019
-
let off3 = off2 + src_consumed in
1020
-
let* dst, dst_consumed = decode_lv buf off3 in
1021
-
let off4 = off3 + dst_consumed in
1022
-
Ok
1023
-
( Metadata
1024
-
{
1025
-
closure_requested = closure;
1026
-
checksum_type = ctype;
1027
-
file_size = fsize;
1028
-
source_filename = src;
1029
-
dest_filename = dst;
1030
-
filestore_requests = [];
1031
-
messages_to_user = [];
1032
-
},
1033
-
off4 - off ))
1034
-
| Some Dir_nak ->
1035
-
let fss_len = if large_file then 8 else 4 in
1036
-
let min_len = 1 + (2 * fss_len) in
1037
-
if len < min_len then Error (Truncated { need = min_len; have = len })
1038
-
else
1039
-
let sscope, _ = decode_fss buf (off + 1) ~large_file in
1040
-
let escope, _ = decode_fss buf (off + 1 + fss_len) ~large_file in
1041
-
let remaining = len - (1 + (2 * fss_len)) in
1042
-
let seg_count = remaining / (2 * fss_len) in
1043
-
let segs = ref [] in
1044
-
let curr_off = ref (off + 1 + (2 * fss_len)) in
1045
-
for _ = 1 to seg_count do
1046
-
let soff, _ = decode_fss buf !curr_off ~large_file in
1047
-
let eoff, _ = decode_fss buf (!curr_off + fss_len) ~large_file in
1048
-
segs := { start_offset = soff; end_offset = eoff } :: !segs;
1049
-
curr_off := !curr_off + (2 * fss_len)
1050
-
done;
1051
-
Ok
1052
-
( Nak
1053
-
{
1054
-
start_scope = sscope;
1055
-
end_scope = escope;
1056
-
segments = List.rev !segs;
1057
-
},
1058
-
!curr_off - off )
1059
-
| Some Dir_prompt ->
1060
-
if len < 2 then Error (Truncated { need = 2; have = len })
1061
-
else
1062
-
let b1 = Char.code buf.[off + 1] in
1063
-
let resp =
1064
-
if b1 land 0x80 = 0 then Prompt_nak else Prompt_keep_alive
1065
-
in
1066
-
Ok (Prompt { response = resp }, 2)
1067
-
| Some Dir_keep_alive ->
1068
-
let fss_len = if large_file then 8 else 4 in
1069
-
if len < 1 + fss_len then
1070
-
Error (Truncated { need = 1 + fss_len; have = len })
1071
-
else
1072
-
let prog, _ = decode_fss buf (off + 1) ~large_file in
1073
-
Ok (Keep_alive { progress = prog }, 1 + fss_len)
1092
+
| Some Dir_eof -> decode_eof ~large_file buf off len
1093
+
| Some Dir_finished -> decode_finished buf off len
1094
+
| Some Dir_ack -> decode_ack buf off len
1095
+
| Some Dir_metadata -> decode_metadata ~large_file buf off len
1096
+
| Some Dir_nak -> decode_nak ~large_file buf off len
1097
+
| Some Dir_prompt -> decode_prompt buf off len
1098
+
| Some Dir_keep_alive -> decode_keep_alive ~large_file buf off len
1074
1099
1075
1100
let decode_continuation b0 =
1076
1101
match (b0 lsr 6) land 0x3 with