File: pdfread.ml

package info (click to toggle)
camlpdf 0.5-1
  • links: PTS, VCS
  • area: non-free
  • in suites: squeeze, wheezy
  • size: 1,516 kB
  • ctags: 2,689
  • sloc: ml: 18,229; ansic: 139; makefile: 139
file content (1318 lines) | stat: -rw-r--r-- 51,191 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
(* \chaptertitle{PDFRead}{Reading PDF from File} *)

(* This module can read PDF files into the format given by the [Pdf] module. It
supports PDF versions 1.0--1.7. The commentary is not in itself sufficient for
full understanding: you must read this together with the Adobe PDF Reference
Manual. Section numbers are from the Fifth Edition. *)
open Utility
open Pdfio

(* Bring Pdf data constructors and functions up to top level. *)
open Pdf

(* \intf Errors in low-level functions, errors in lexing, errors in parsing. *)
exception PDFReadError of string
exception PDFLexError of string
exception PDFParseError of string

(* \intf Errors in the structure of the PDF (i.e not in its basic syntax.) *)
exception PDFSemanticError of string
  
(* Predicate on newline characters (carriage return and linefeed). *)
let is_newline = function
  | '\010' | '\013' -> true
  | _ -> false

let input_line i =
  let goteol = ref false
  and chars = ref []
  and finished = ref false in
    while not !finished do
      match i.input_byte () with
      | x when x = Pdfio.no_more -> set finished
      | x -> 
         let c = char_of_int x in
           if is_newline c then set goteol else
             if !goteol
               then (rewind i; set finished)
               else chars =| c
   done;
   implode (rev !chars)

(* Read back until a predicate is fulfilled. *)
let rec read_back_until p i =
  if (notpred p) (match read_char_back i with Some x -> x | None -> dpr "Q"; raise End_of_file)
    then read_back_until p i

(* Go back one line. In other words, find the second EOL character group
seeking back in the file, and seek to the character after it. A blank line
after a line with a single EOL character will be treated as being part of that
EOL. *)
let backline i =
  read_back_until is_newline i;
  read_back_until (notpred is_newline) i;
  read_back_until is_newline i;
  nudge i

(* Read the major and minor version numbers  from a PDF [1.x] file. Fail if
header invalid or major version number is not 1.  *)
let get9chars i =
  let c1 = i.input_char () in
  let c2 = i.input_char () in
  let c3 = i.input_char () in
  let c4 = i.input_char () in
  let c5 = i.input_char () in
  let c6 = i.input_char () in
  let c7 = i.input_char () in
  let c8 = i.input_char () in
  let c9 = i.input_char () in
    try map unopt [c1; c2; c3; c4; c5; c6; c7; c8; c9] with _ -> []

let rec read_header_inner pos i =
  try
    if pos > 1024 then (dpr "R"; raise End_of_file) else
      i.seek_in (posofi pos);
      match get9chars i with
      | '%'::'P'::'D'::'F'::'-'::_::'.'::minor ->
          let minorchars = takewhile isdigit minor in
            if minorchars = []
              then
                raise (PDFReadError "Malformed PDF header")
              else
                begin
                  i.set_offset (posofi pos);
                  1, int_of_string (implode minorchars)
                end
      | _ ->
          read_header_inner (pos + 1) i
  with
    End_of_file | Failure "int_of_string" ->
      raise (PDFReadError "Could not read PDF header")

let read_header =
  read_header_inner 0

(* Find the EOF marker, and move position to its first character. We allow 1024
bytes from end-of-file for compatibility with Acrobat. *)
let find_eof i =
  let fail () = raise (PDFReadError "Could not find EOF marker")
  and pos = ref (possub (i.in_channel_length ()) (posofi 4)) in
    try
      let notfound = ref true
      and tries = ref 1024 in
        while !notfound do
          pos := pos_pred !pos;
          i.seek_in !pos;
          if !tries < 0 then fail () else decr tries;
          let l = input_line i in
            if l = "%%EOF" then clear notfound;
        done;
        i.seek_in !pos;
    with
      _ -> fail ()

(* Lexemes. *)
type lexeme =
  | LexNull
  | LexBool of bool
  | LexInt of int
  | LexReal of float
  | LexString of string
  | LexName of string
  | LexLeftSquare
  | LexRightSquare
  | LexLeftDict
  | LexRightDict
  | LexStream of stream
  | LexEndStream
  | LexObj
  | LexEndObj
  | LexR
  | LexComment
  | StopLexing
  | LexNone

(* String of lexeme. *)
let string_of_lexeme = function
  | LexNull -> "null"
  | LexBool b -> Pdfwrite.string_of_pdf (Boolean b)
  | LexInt i -> Pdfwrite.string_of_pdf (Integer i)
  | LexReal f -> Pdfwrite.string_of_pdf (Real f)
  | LexString s -> Pdfwrite.string_of_pdf (String s)
  | LexName s -> s
  | LexLeftSquare -> "["
  | LexRightSquare -> "]"
  | LexLeftDict -> "<<"
  | LexRightDict -> ">>"
  | LexStream _ -> "LexStream"
  | LexEndStream -> "EndStream"
  | LexObj -> "obj"
  | LexEndObj -> "endobj"
  | LexR -> "R"
  | LexComment -> "Comment"
  | StopLexing -> "StopLexing"
  | LexNone -> "LexNone"

let print_lexeme l =
  Printf.printf "%s " (string_of_lexeme l)

(* Predicate on whitespace and delimiters. *)
let is_whitespace_or_delimiter c =
  is_whitespace c || is_delimiter c

(* Return the list of characters between and including the current position and
before the next character satisfying a given predicate, leaving the position at
the character following the last one returned. Can raise [EndOfInput]. If [eoi]
is true, end of input is considered a delimiter, and the characters up to it are
returned if it is reached. *)
let getuntil eoi f i =
  let rec getuntil_inner r eoi f i =
    match i.input_byte () with
    | x when x = Pdfio.no_more ->
        if eoi then rev r else (dpr "T"; raise End_of_file)
    | x ->
        let chr = char_of_int x in
          if f chr
            then (rewind i; rev r)
            else getuntil_inner (chr::r) eoi f i
  in
    getuntil_inner [] eoi f i

(* The same, but don't return anything. *)
let rec ignoreuntil eoi f i =
  match i.input_byte () with
  | x when x = Pdfio.no_more -> if eoi then () else (dpr "V"; raise End_of_file)
  | x -> if f (char_of_int x) then rewind i else ignoreuntil eoi f i

(* Ignore until the next whitespace *)
let ignoreuntilwhite =
  ignoreuntil true is_whitespace

(* Position on the next non-whitespace character. *)
let dropwhite i =
  ignoreuntil true (notpred is_whitespace) i

(* The same, but stop at array, dictionary endings etc. *)
let getuntil_white_or_delimiter =
  getuntil true is_whitespace_or_delimiter

(* \section {Lexing} *)

(* Each of the following functions lexes a particular object, leaving the
channel position at the character after the end of the lexeme. Upon entry, the
file position is on the first character of the potential lexeme. \smallgap*)

(* Lex a bool. *)
let lex_bool i =
  match implode (getuntil_white_or_delimiter i) with
  | "true" -> LexBool true
  | "false" -> LexBool false
  | _ -> LexNone

(* Lex an int or float. See PDF manual for details of policy. *)
let lex_number i =
  let number = implode (getuntil_white_or_delimiter i) in
    try
      match hd (Cgenlex.lex (input_of_bytestream (bytestream_of_string number))) with
      | Cgenlex.Int i -> LexInt i
      | Cgenlex.Float f -> LexReal f
      | _ -> LexNone
    with
    | Failure "hd" -> dpr "3F"; LexNone
    | PDFError _ (* can't cope with floats where number has leading point. *)
    | Failure "int_of_string" -> dpr "3G";
        LexReal (float_of_string number) (*r [float_of_string] never fails. *)

(* Lex a name. We need to nudge past the slash and then add it manually since it
is also a delimiter. Note that this correctly lexes the name consisting of just
the slash, which is valid. *)
let rec substitute_hex prev = function
  | [] -> rev prev
  | '#'::a::b::more ->
      let chr =
        char_of_int (int_of_string ("0x" ^ implode [a; b]))
        (*i char_of_int (Scanf.sscanf (implode [a;b]) "%x" ident) i*)
      in
        substitute_hex (chr::prev) more
  | chr::more ->
      substitute_hex (chr::prev) more

let lex_name i =
  nudge i;
  let rawchars = "/" ^ (implode (getuntil_white_or_delimiter i)) in
    let substituted = implode (substitute_hex [] (explode rawchars)) in
      LexName substituted

(* Lex a comment. We throw away everything from here until a new line. In the
case of a CRLF, only the CR is consumed, but the LF will be consumed before the
next token is read anyway, so this is fine. *)
let lex_comment i =
  ignoreuntil false is_newline i;
  LexComment

(* Lex a string. A string is between parenthesis. Unbalanced parenthesis in the
string must be escaped, but balanced ones need not be. We convert escaped
characters to the characters themselves. A newline sequence following a
backslash represents a newline. The string is returned without its enclosing
parameters. \smallgap *)

(* PDF strings can contain characters as a backslash followed by up to three
octal characters. If there are fewer than three, the next character in the file
cannot be a digit (The format is ambiguous as to whether this means an
\emph{octal} digit --- we play safe and allow non-octal digits). This replaces
these sequences of characters by a single character as used by OCaml in its
native strings.

Beware malformed strings. For instance, Reader accepts ((\\(ISA)) \smallgap *)

(* Build a character from a list of octal digits. *)
let mkchar l =
  try
    char_of_int (int_of_string ("0o" ^ implode l))
    (*i char_of_int (Scanf.sscanf (implode l) "%o" ident) i*)
  with
    _ -> raise (PDFError ("mkchar"))

(* Main function. *)
let lex_string i =
  try
    let str = Buffer.create 16 in
    let addchar = Buffer.add_char str
    and paren = ref 1
    and c = char_of_int (i.input_byte ()) in
    assert (c = '(');
    while !paren > 0 do
      let c = char_of_int (i.input_byte ()) in
      match c with
        | '(' ->
            incr paren; addchar c;
        | ')' ->
            decr paren; if !paren > 0 then addchar c;
        | '\\' ->
            let c' = char_of_int (i.input_byte ()) in
            (match c' with
              | 'n' -> addchar '\n'
              | 'r' -> addchar '\r'
              | 't' -> addchar '\t'
              | 'b' -> addchar '\b'
              | 'f' -> addchar '\012'
              | '\r' ->
                  if char_of_int (i.input_byte ()) <> '\n' then
                    rewind i
              | '\n' -> ()
              | '0'..'7' ->
                (* Replace octal character sequences with the real character. *)
                  let o2 = char_of_int (i.input_byte ()) in
                  (match o2 with
                    | '0'..'7' ->
                        let o3 = char_of_int (i.input_byte ()) in
                        (match o3 with
                          | '0'..'7' ->
                              addchar (mkchar [c'; o2; o3])
                          | _ ->
                              rewind i;
                              addchar (mkchar [c'; o2]))
                    | _ ->
                        rewind i;
                        addchar (mkchar [c']))
              | _ -> (* including ['('], [')'], ['\\'], and all the others *)
                  addchar c' )
        | _ ->
            addchar c
    done;
    LexString (Buffer.contents str)
  with
    | Failure "unopt" -> raise (PDFReadError "lex_string")

(* Lex a hexadecimal string. *)
let lex_hexstring i =
  let mkchar a b =
    try
      char_of_int (int_of_string ("0x" ^ implode [a; b]))
    with
      _ -> raise (PDFError ("Lexing Hexstring: "))
  in
    try
      let _ = i.input_byte () (*r skip start marker *)
      and str = Buffer.create 16
      and finished = ref false in
        let addchar = Buffer.add_char str in
          let rec input_next_char () =
            let c = char_of_int (i.input_byte ()) in
              if is_whitespace c then input_next_char () else c
          in
            while not !finished do
              let c = input_next_char () in
              let c' = input_next_char () in
                match c, c' with
                | '>', _ -> rewind i; set finished
                | a, '>' -> addchar (mkchar a '0')
                | a, b -> addchar (mkchar a b)
            done;
            LexString (Buffer.contents str)
     with
       | Failure "unopt" -> raise (PDFReadError "lex_hexstring")

(* Lex a keyword. *)
let lex_keyword i =
  match implode (getuntil_white_or_delimiter i) with
  | "obj" -> LexObj
  | "endobj" -> LexEndObj
  | "R" -> LexR
  | "null" -> LexNull
  | "endstream" -> LexEndStream
  | _ -> LexNone

(* Lex a stream, given its length (previously extracted by parsing the stream
dictionary). If [opt] is [true] the stream is actually read, if [false] a
[ToGet] tuple is created. The channel is positioned on the first character of
the stream keyword. *)
let lex_stream_data i l opt =
  try
    ignoreuntilwhite i;
    (* Skip either CRLF or LF. (See PDF specification for why) *)
    begin match char_of_int (i.input_byte ()) with
    | '\013' ->
        begin match char_of_int (i.input_byte ()) with
        | '\010' -> () (* It was CRLF *)
        | _ -> rewind i (* No padding, happens to be CR *)
        end
    | '\010' -> () (* Just LF *)
    | _ -> rewind i (* No padding. *)
    end;
    if opt then
      let arr = mkstream l in
        if l > 0 then
          for k = 0 to l - 1 do
            sset arr k (i.input_byte ())
          done;
        LexStream (Got arr)
    else
      (* Advance past the stream data. *)
      let pos = i.pos_in ()
      and l = posofi l in
        i.seek_in (posadd pos l);
        LexStream (ToGet (i, postoi64 pos, postoi64 l))
  with
    _ -> raise (PDFError "lex_stream_data")

(* Lex a stream. This involves \emph{parsing} the stream dictionary to get the
length. [i] is at the start of the stream data, suitable for input to
[lex_stream_data]. We extract the dictionary by going through
[previous_lexemes], the reverse-order list of the lexemes already read. *)
let lex_stream i p previous_lexemes lexobj opt =
  let fail () = raise (PDFLexError "Failure lexing stream dict.") in
    let dictlexemes =
      [LexInt 0; LexInt 0; LexObj] @
      rev
        (takewhile (fun x -> x <> LexObj) previous_lexemes) @
      [LexEndObj]
    in
      match p dictlexemes with
        | _, Dictionary a ->
          let rec findlength = function
            | Integer l -> Some l
            | Indirect k -> findlength (snd (p (lexobj k)))
            | _ -> None
          in
            begin match lookup "/Length" a with
              | None -> fail ()
              | Some v ->
                 match findlength v with
                 | None -> fail ()
                 | Some l -> lex_stream_data i l opt
            end
        | _ -> fail ()

(* Find the next lexeme in the channel and return it. The latest-first lexeme
list [previous_lexemes] contains all things thus-far lexed. [dictlevel] is a
number representing the dictionary and/or array nesting level. If [endonstream] is true,
lexing ends upon encountering a [LexStream] lexeme. *)
let lex_next dictlevel arraylevel endonstream i previous_lexemes p opt lexobj =
  try
    dropwhite i;
    (* To avoid problems with lexing at the end of the input, produce whitespace
    when input ends. *)
    let chr1 = char_of_int (i.input_byte ()) in
      rewind i;
      match chr1 with
      | '%' -> lex_comment i
      | 't' | 'f' -> lex_bool i
      | '/' -> lex_name i
      | '0'..'9' | '+' | '-' | '.' -> lex_number i
      | '[' -> nudge i; incr arraylevel; LexLeftSquare
      | ']' -> nudge i; decr arraylevel; LexRightSquare
      | '(' -> lex_string i
      | '<' ->
        let _ = char_of_int (i.input_byte ()) in
          let chr2 = char_of_int (i.input_byte ()) in
            rewind2 i;
            begin match chr2 with
            | '<' -> nudge i; nudge i; incr dictlevel; LexLeftDict
            | _ -> lex_hexstring i
            end 
      | '>' ->
        let _ = i.input_byte () in
          let chr2 = char_of_int (i.input_byte ()) in
            rewind2 i;
            begin match chr2 with
            | '>' -> nudge i; nudge i; decr dictlevel; LexRightDict
            | _ -> LexNone
            end
      | 'R' -> nudge i; LexR
      | 's' ->
          (* Disambiguate ``startxref'' and ``stream'' on the third character. *)
          let _ = i.input_byte () in
            let _ = i.input_byte () in
              let chr3 = char_of_int (i.input_byte ()) in
                rewind3 i;
                begin match chr3 with
                | 'a' -> StopLexing (*r startxref *)
                | _ -> (*r stream *)
                   if endonstream
                     then StopLexing
                     else lex_stream i p previous_lexemes lexobj opt
                end
      | 'a'..'z' -> lex_keyword i
      | 'I' -> StopLexing (*r We've hit an ID marker in an inline image *)
      | _ -> LexNone
  with
    _ -> dpr "3D"; StopLexing

(* Lex just a dictionary, consuming only the tokens to the end of it. This is
used in the [PDFPages] module to read dictionaries in graphics streams. *)
let lex_dictionary i =
  let rec lex_dictionary_getlexemes i lexemes dictlevel arraylevel =
    let lex_dictionary_next i dictlevel arraylevel =
      let dummyparse = fun _ -> 0, Null
      and dummylexobj = fun _ -> [] in
        lex_next dictlevel arraylevel false i [] dummyparse false dummylexobj
    in
      match lex_dictionary_next i dictlevel arraylevel with
      | LexRightDict when !dictlevel = 0 ->
          rev (LexRightDict::lexemes)
      | StopLexing ->
          rev lexemes
      | LexNone ->
          raise (PDFReadError "Could not read dictionary")
      | a ->
          lex_dictionary_getlexemes i (a::lexemes) dictlevel arraylevel
  in
    lex_dictionary_getlexemes i [] (ref 0) (ref 0)
 
(* Calculate a list of lexemes from input [i], using parser [p] to lex
streams. Can raise [PDFReadError]. *)
let lex_object_at oneonly i opt p lexobj =
  let dictlevel = ref 0
  and arraylevel = ref 0 in
    let rec lex_object_at i lexemes =
      let lexeme = lex_next dictlevel arraylevel false i lexemes p opt lexobj in
        (*i flprint "lex_object_at: LEXEME:"; print_lexeme lexeme; flprint "\n"; i*)
        match lexeme with
        | LexEndObj -> rev (lexeme::lexemes) 
        | StopLexing -> rev lexemes
        | LexComment -> lex_object_at i (lexeme::lexemes)
        | LexRightSquare | LexRightDict ->
            (*i Printf.printf "LexRightSquare or LexRightDict: oneonly = %b, dictlevel %i, arraylevel %i\n" oneonly !dictlevel !arraylevel; i*)
            if oneonly && !dictlevel = 0 && !arraylevel = 0
              then
                (* 02/12/08 - We need to peek ahead to see if there's a stream here. *)
                begin
                  let pos = i.pos_in () in
                    match lex_next dictlevel arraylevel false i (lexeme::lexemes) p opt lexobj with
                    | LexStream s ->
                        begin match lex_next dictlevel arraylevel false i (LexStream s::lexeme::lexemes) p opt lexobj with
                        | LexEndStream ->
                            begin match lex_next dictlevel arraylevel false i (LexEndStream::LexStream s::lexeme::lexemes) p opt lexobj with
                            | LexEndObj -> rev (LexEndObj::LexEndStream::LexStream s::lexeme::lexemes)
                            | _ ->
                               Printf.eprintf "\nStopped at %Li\n" (i.pos_in ());
                               raise (PDFReadError "Could not read object (oneonly - 2)")
                            end
                        | _ -> 
                           Printf.eprintf "\nStopped at %Li\n" (i.pos_in ());
                           raise (PDFReadError "Could not read object (oneonly)")
                        end
                    | _ -> i.seek_in pos; rev (lexeme::lexemes)
                end
              else lex_object_at i (lexeme::lexemes)
        | LexNone ->
            Printf.eprintf "\nStopped at %Li\n" (i.pos_in ());
            raise (PDFReadError "Could not read object")
        | LexInt i1 ->
            (* Check for the case of "x y obj", which in the case of oneonly
            should be returned as the one object. If i is followed by something
            other than an integer and 'obj', we must rewind and just return the
            integer *)
            if oneonly && !dictlevel = 0 && !arraylevel = 0 then
              let pos = i.pos_in () in
                begin match lex_next dictlevel arraylevel false i lexemes p opt lexobj with
                | LexInt i2 ->
                   begin match lex_next dictlevel arraylevel false i lexemes p opt lexobj with
                   | LexObj ->
                       lex_object_at i (LexObj::LexInt i2::LexInt i1::lexemes)
                   | _ ->
                     i.seek_in pos;
                     rev (LexInt i1::lexemes)
                   end
                | _ ->
                   i.seek_in pos;
                   rev (LexInt i1::lexemes)
                end
            else
              lex_object_at i (LexInt i1::lexemes)
        | a ->
           (* If oneonly, then can return if not in an array or dictionary and if this lexeme was an atom. *)
           (* FIXME: This wouldn't cope with just an indirect reference 0 1 R - but this would be very odd. *)
           let isatom = function
             | LexBool _ | LexReal _ | LexString _ | LexName _ -> true
             | _ -> false
           in
             if oneonly && isatom a && !dictlevel = 0 && !arraylevel = 0
               then rev (a::lexemes)
               else lex_object_at i (a::lexemes)
    in
      lex_object_at i []

(* Type of sanitized cross-reference entries. They are either plain offsets, or
an object stream an index into it. *)
type xref =
  | XRefPlain of pos * int (*r offset, generation. *)
  | XRefStream of int * int (*r object number of stream, index. *)

let string_of_xref = function
  | XRefPlain (p, i) -> Printf.sprintf "XRefPlain (%Li, %i)" p i
  | XRefStream (o, i) -> Printf.sprintf "XrefStream %i, index %i" o i

let xrefs_table_create () = Hashtbl.create 1001

(*IF-OCAML*)
let xrefs_table_add_if_not_present table k v =
  try ignore (Hashtbl.find table k)(*i ; Printf.printf "xref to obj %i already present\n" k i*)with
    Not_found -> Hashtbl.add table k v

let xrefs_table_find table k =
  try Some (Hashtbl.find table k) with
    Not_found -> None

(*ENDIF-OCAML*)

(*i*)(*F#
let xrefs_table_add_if_not_present table k v =
  match Hashtbl.tryfind table k with
  | Some _ -> ()
  | None -> Hashtbl.add table k v

let xrefs_table_find table k =
  Hashtbl.tryfind table k
F#*)(*i*)

let xrefs_table_iter = Hashtbl.iter

(* [p] is the parser. Since this will be called from within functions it also
calls, we must store and retrieve the current file position on entry and exit. *)
let rec lex_object i xrefs p opt n =
  (*i Printf.printf "lexing nonstream object %i\n" n;
  if mem n intobjs then
    Printf.printf "lexing interesting nonstream object %i\n" n; i*)
  let current_pos = i.pos_in () in
     let xref =
       match xrefs_table_find xrefs n with
       | Some x -> x
       | None -> raise (PDFReadError "Object not in xref table")
     in
       match xref with
       | XRefStream (objstm, index) ->
           raise (Assert_failure ("lex_object", 0, 0)) (*r lex object only used on XRefPlain entries *)
       | XRefPlain (o, _) ->
           i.seek_in o;
           let result = lex_object_at false i opt p (lex_object i xrefs p opt) in
             i.seek_in current_pos;
             result

(* Given an object stream pdfobject and a list of object indexes to extract,
 return an [int * lexeme list list] representing those object number, lexeme
 pairs. *)
let lex_stream_object i xrefs parse opt obj indexes user_pw partial_pdf gen =
  (*i Printf.printf "lexing object stream %i\nTo find\n" obj;
  iter (Printf.printf "%i ") indexes;
  flprint "\n"; i*)
  let _, stmobj = parse (lex_object i xrefs parse opt obj) in
    match stmobj with
    | Stream {contents = Dictionary d, stream} ->
        (* We assume that these are direct entries. *)
        let n =
          match lookup "/N" d with
          | Some (Integer n) -> n
          | _ -> raise (PDFSemanticError "missing/malformed /N")
        and first =
          match lookup "/First" d with
          | Some (Integer n) -> n
          | _ -> raise (PDFSemanticError "missing/malformed /First")
        in
          (* Decrypt if necessary *)
          let stmobj =
            Pdfcrypt.decrypt_single_stream user_pw partial_pdf obj gen stmobj
          in
          Pdfcodec.decode_pdfstream (Pdf.empty ()) stmobj;
          begin match stmobj with
          | Stream {contents = _, Got raw} ->
            let i = input_of_bytestream raw in
              begin try
                (* Read index. *)
                let rawnums = ref [] in
                  for x = 1 to n * 2 do
                    dropwhite i;
                    rawnums =|
                      match lex_number i with
                      | LexInt i -> i
                      | k -> raise (PDFSemanticError "objstm offset")
                  done;
                  rawnums := rev !rawnums;
                  (* Read each object *)
                  let pairs = pairs_of_list !rawnums
                  and objects = ref []
                  and index = ref 0 in
                    iter
                      (fun (objnum, offset) ->
                         (*i Printf.printf "Do we want object %i ?\n" objnum; i*)
                         if mem !index indexes then
                           begin
                             (*i Printf.printf "Extracting object from object stream (num = %i, offset = %i)\n" objnum offset; i*)
                             i.seek_in (posofi (offset + first));
                             let lexemes =
                               lex_object_at true i opt parse (lex_object i xrefs parse opt)
                             in
                               (*i if mem objnum intobjs then (iter print_lexeme lexemes; flprint "\n"); i*)
                               objects =| (objnum, lexemes);
                           end;
                           incr index)
                      pairs;
                    (* Remove object stream from the PDF, so that decryption still works, and because we no longer need it. *)
                    Pdf.addobj_given_num partial_pdf (obj, Pdf.Null);
                    rev !objects
              with
                End_of_file ->
                  raise (PDFSemanticError "unexpected objstream end")
              end
          | _ -> raise (PDFSemanticError "couldn't decode objstream")
          end
    | _ -> raise (PDFSemanticError "lex_stream_object: not a stream")

(* \section{Parsing} *)

(* Parsing proceeds as a series of operations over lists of lexemes or parsed
objects. Parsing ends when the list is a singleton and its element is an
well-formed object. *)
type partial_parse_element =
  | Lexeme of lexeme
  | Parsed of pdfobject

(* Parse stage one --- parse basic lexemes. *)
let parse_initial =
  map
    (function
     | Lexeme LexNull -> Parsed Null
     | Lexeme (LexBool b) -> Parsed (Boolean b)
     | Lexeme (LexInt i) -> Parsed (Integer i)
     | Lexeme (LexReal r) -> Parsed (Real r)
     | Lexeme (LexString s) -> Parsed (String s)
     | Lexeme (LexName n) ->
         Parsed (Name n)
     | l -> l)

let print_partial = function
  | Lexeme l -> print_lexeme l
  | Parsed p -> Printf.printf "PARSED: %s\n" (Pdfwrite.string_of_pdf p)

(* Parse stage two. Parse indirect references. Also remove any dummy
[LexComment] tokens. *)
let parse_R ts =
  let rec parse_R_inner r = function
    | [] -> rev r
    | Parsed (Integer o)::Parsed (Integer _)::Lexeme LexR::rest ->
        parse_R_inner (Parsed (Indirect o)::r) rest
    | Lexeme LexComment::t -> parse_R_inner r t
    | h::t -> parse_R_inner (h::r) t
  in
    parse_R_inner [] ts

(* Parse stage three. Repeatedly parse dictionaries and arrays, bottom up. This
should leave everything parsed other than the object itself. *)
let rec get_lexemes_to_symbol l s = function
  | [] -> None
  | Lexeme s'::t when s = s' -> Some (rev l, t)
  | Lexeme (LexLeftDict | LexLeftSquare)::_ -> None
  | Parsed _ as h::t -> get_lexemes_to_symbol (h::l) s t
  | Lexeme h::t ->
      raise (PDFParseError "get_lexemes_to_symbol: Bad dict or array?")

let rec replace_dictarray prev = function
  | [] -> rev prev
  | Lexeme LexLeftDict::t ->
      begin match get_lexemes_to_symbol [] LexRightDict t with
      | None -> replace_dictarray (Lexeme LexLeftDict::prev) t
      | Some (lexemes, rest) ->
          if odd (length lexemes)
            then
              raise (PDFParseError "replace_dictarray 1")
            else
              let pairs =
                map
                  (function
                   | Parsed (Name k), Parsed v -> k, v
                   | _ -> raise (PDFParseError "replace_dictarray 2"))
                  (pairs_of_list lexemes)
            in
              replace_dictarray (Parsed (Dictionary pairs)::prev) rest
      end
  | Lexeme LexLeftSquare::t ->
      begin match get_lexemes_to_symbol [] LexRightSquare t with
      | None -> replace_dictarray (Lexeme LexLeftSquare::prev )t
      | Some (lexemes, rest) ->
          let arry =
            map
              (function
               | Parsed x -> x
               | _ -> raise (PDFParseError "replace_dictarray 3"))
              lexemes
          in
            replace_dictarray (Parsed (Array arry)::prev) rest
      end
  | h::t -> replace_dictarray (h::prev) t

(* Debug printing of parsemes. *)
let print_parseme = function
  | Parsed p -> flprint "PARSED:"; print_string (Pdfwrite.string_of_pdf p); flprint "\n"
  | Lexeme l -> flprint "LEXEME:"; print_lexeme l; flprint "\n" 

(* Call [replace_dictarray] repeatedly until no arrays or dictionaries to do,
then extract the object. Possible correct forms: (1)~Normal object (2)~Stream
object (3)~Trailer dictionary. This can be non-terminating on bad input, so
bail out after 5000 recursions. *)
let rec parse_reduce recs l =
  if recs = 5000 then raise (PDFReadError "Parse error") else
    let rec parse_finished = function
      | [] -> true
      | Lexeme (LexLeftSquare | LexLeftDict)::_ -> false
      | _::t -> parse_finished t
    in
      if parse_finished l then
        match l with
        | [Parsed (Integer o); Parsed (Integer g);
          Lexeme LexObj; Parsed obj; Lexeme LexEndObj]
        | [Parsed (Integer o); Parsed (Integer g);
          Lexeme LexObj; Parsed obj] ->
            o, obj
        | Parsed (Integer o)::
          Parsed (Integer g)::
          Lexeme LexObj::
          Parsed obj::
          Lexeme (LexStream s)::
          Lexeme LexEndStream::_ when last l = Lexeme LexEndObj ->
            o, Stream {contents = obj, s}
        | [Parsed d] ->
            0, d
        | l ->
            (*i flprint "PARSEMES:\n";
            iter print_parseme l;
            flprint "END OF PARSEMES\n"; i*)
            raise (PDFReadError "Could not extract object")
      else
        parse_reduce (recs + 1) (replace_dictarray [] l)

(* Parse some lexemes *)
let parse lexemes =
  parse_reduce 0 (parse_R (parse_initial (map (fun x -> Lexeme x) lexemes)))

let parse_objnum objnum' lexemes =
   (objnum', snd (parse lexemes))

(* Advance to the first thing after the current pointer which is not a comment. *)
let rec ignore_comments i =
  let pos = i.pos_in () in
    match i.input_char () with
    | Some '%' ->
      (ignore (input_line i); ignore_comments i)
    | Some _ -> i.seek_in pos
    | None -> dpr "W"; raise End_of_file

(* \section{Cross-reference tables} *)

(* Read the cross-reference table. Supports the multiple sections created when
a PDF file is incrementally modified. *)
type xref_line =
  | Invalid
  | Section of int * int (*r Start, length. *)
  | Valid of pos * int (*r byte offset, gen. *)
  | Free of pos * int (*r free entry. *)
  | InObjectStream of int * int (*r Stream number, index. *)
  | StreamFree of pos * int (*r free entry in an object stream. *)
  | XRefNull (*r is the null object. *)
  | Finished (*r end of a table. *)

(* Read and parse a single line of a cross-reference table. We use a
long-winded match pattern on the characters of cross-reference lines because a
byte offset can exceed the range for [Genlex.Int]. *)
let rec read_xref_line i =
  let pos = i.pos_in () in
    let line = input_line i in
      if line = "xref" then read_xref_line i else
        let is09 x =
          x >= '0' && x <= '9'
        in
        match explode line with
        | 't'::'r'::'a'::'i'::'l'::'e'::'r'::more ->
            (* Bad files may not put newlines after the trailer, so [input_line] may
            have taken too much, preventing us from reading the trailer
            dictionary, so we rewind. *)
            i.seek_in (posadd pos (posofi 7));
            Finished
        | a::b::c::d::e::f::g::h::i::j::' '::k::l:: m::n::o::' '::r
           when is09 a && is09 b && is09 c
             && is09 d && is09 e && is09 f
             && is09 g && is09 h && is09 i
             && is09 j && is09 k && is09 l
             && is09 m && is09 n && is09 o ->
           let p, i =
             Int64.of_string (implode [a; b; c; d; e; f; g; h; i; j]),
             int_of_string (implode [k; l; m; n; o])
           in
             begin
               match r with
               | 'n'::_ -> Valid (posofi64 p, i)
               | 'f'::_ -> Free (posofi64 p, i)
               | _ -> Invalid
             end
        | _ ->
          (* Artworks produces bad PDF with lines like \texttt{xref 1 5} *)
          match Cgenlex.lex (input_of_bytestream (bytestream_of_string line)) with
          | [Cgenlex.Ident "xref"; Cgenlex.Int s; Cgenlex.Int l]
          | [Cgenlex.Int s; Cgenlex.Int l] -> Section (s, l)
          | _ -> Invalid 

(* Read the cross-reference table in [i] at the current position. Leaves [i] at
the first character of the trailer dictionary. *)
let read_xref i =
  let fail () = raise (PDFReadError "Could not read x-ref table")
  and xrefs = ref [] in
    begin try
      let finished = ref false
      and objnumber = ref 1 in
        while not !finished do
          match read_xref_line i with
          | Invalid -> fail ()
          | Valid (offset, gen) ->
              xrefs =| (!objnumber, XRefPlain (offset, gen));
              incr objnumber
          | Finished -> set finished
          | Section (s, _) -> objnumber := s
          | Free _ -> incr objnumber
          | _ -> () (* Xref stream types won't have been generated. *)
        done
      with
        End_of_file | (*IF-OCAML*)Sys_error _ | (*ENDIF-OCAML*)Failure "int_of_string"-> fail ()
    end;
    !xrefs

(* PDF 1.5 cross-reference stream support. [i] is the input. The tuple describes
the lengths in bytes of each of the three fields. *)
let read_xref_line_stream i (w1, w2, w3) =
  assert (w1 >= 0 && w2 >= 0 && w3 >= 0);
  try
    let rec mknum mul = function
      | [] -> 0L
      | h::t -> i64add (i64mul (i64ofi h) mul) (mknum (i64mul mul 256L) t)
    in
      let rec read_field bytes = function
        | 0 -> mknum 1L bytes (* Lower order byte first. *)
        | n ->
          match i.input_byte () with
          | x when x = Pdfio.no_more -> raise (PDFError "")
          | b -> read_field (b::bytes) (n - 1)
      in
        let f1 = read_field [] w1 in
          let f2 = read_field [] w2 in
            let f3 = read_field [] w3 in
              match f1 with
              | 0L -> StreamFree (posofi64 f2, i64toi f3)
              | 1L -> Valid (posofi64 f2, i64toi f3)
              | 2L -> InObjectStream (i64toi f2, i64toi f3)
              | n -> XRefNull
  with
    _ -> raise (PDFReadError "read_xref_line_stream")

(* The function to read a whole cross-reference stream, and return an [xref
list]. Leaves [i] at the first character of the stream dictionary, which
containes the trailer dictionary entries. *)
let read_xref_stream i =
  let original_pos = i.pos_in ()
  and err = PDFReadError "Bad xref stream" in
    let rec lex_untilstream i ls =
      let lexobj = lex_object i (null_hash ()) parse false in
        match lex_next (ref 0) (ref 0) true i [] parse false lexobj with
        | StopLexing | LexNone -> rev ls (* Added LexNone to prevent infintite loop on malformed files 14/10/09 *)
        | l -> lex_untilstream i (l::ls)
    in
      let stream, obj, gen =
        match
          try
          let lexobj = lex_object i (null_hash ()) parse true in
            let dictlex = lex_untilstream i [] in
              let obj =
                match hd dictlex with
                | LexInt i -> i
                | _ -> raise Not_found
              and gen =
                match (hd (tl dictlex)) with
                | LexInt i -> i
                | _ -> raise Not_found
              in
                begin match lex_stream i parse (rev dictlex) lexobj true with
                | LexNone -> raise err
                | stream ->
                    snd (parse (dictlex @ [stream] @ [LexEndStream; LexEndObj])),
                    obj,
                    gen
                end
          with _ -> raise (PDFError "Failure to read xref stream - malformed")
        with
        | Stream _ as stream, obj, gen -> stream, obj, gen
        | _ -> raise err
      in
        Pdfcodec.decode_pdfstream (Pdf.empty ()) stream;
        let ws =
          match lookup_direct (Pdf.empty ()) "/W" stream with
          | Some (Array [Integer w1; Integer w2; Integer w3]) -> w1, w2, w3
          | _ -> raise err
        and i' =
          match stream with
          | Stream {contents = _, Got s} -> input_of_bytestream s
          | _ -> raise err
        and xrefs = ref [] in
          begin try
            while true do
              xrefs =| read_xref_line_stream i' ws;
            done
          with
            _ -> dpr "3H"; ()
          end;
          xrefs := rev !xrefs;
          let starts_and_lens =
            match lookup_direct (Pdf.empty ()) "/Index" stream with
            | Some (Array elts) ->
                if odd (length elts) then raise (PDFReadError "Bad /Index");
                map
                  (function
                    | (Pdf.Integer s, Pdf.Integer l) -> s, l
                    | _ -> raise (PDFReadError "Bad /Index entry"))
                  (pairs_of_list elts)
            | Some _ -> raise (PDFSemanticError "Unknown /Index")
            | None ->
                let size =
                  match lookup_direct (Pdf.empty ()) "/Size" stream with
                  | Some (Integer s) -> s
                  | _ ->
                      raise (PDFSemanticError "Missing /Size in xref dict")
                in
                  [0, size]
          in
            let xrefs' = ref [] in
            iter
              (fun (start, len) ->
                let these_xrefs =
                  try take !xrefs len with
                    _ -> raise (PDFReadError "Bad xref stream\n")
                in
                  xrefs := drop !xrefs len;
                  let objnumber = ref start in
                    iter
                      (function
                       | Valid (offset, gen) ->
                           xrefs' =| (!objnumber, XRefPlain (offset, gen));
                           incr objnumber
                       | InObjectStream (stream, index) ->
                           xrefs' =| (!objnumber, XRefStream (stream, index));
                           incr objnumber
                       | _ -> incr objnumber)
                      these_xrefs)
                starts_and_lens;
              i.seek_in original_pos;
              rev !xrefs'

(* A suitable function for the Pdf module to use to lex and parse an object.
Assumes [i] has been set to the correct position. [n] is the object number. *)
let get_object i xrefs n =
  let lexemes = lex_object i xrefs parse false n in
    snd (parse_objnum n lexemes)

(* \section{Main functions} *)

(* Read a PDF from a channel. If [opt], streams are read immediately into
memory. *)
let read_pdf user_pw opt i =
  let xrefs = xrefs_table_create () in
  let major, minor = read_header i 
  and objects_stream, objects_nonstream, root, trailerdict =
    let addref (n, x) = xrefs_table_add_if_not_present xrefs n x
    and got_all_xref_sections = ref false
    and trailerdict = ref []
    and xref = ref 0L
    and first = ref true in
      (* This function builds a partial pdf of the plain objects whose
      references have currently been seen. *)
      let mkpartial trailerdict =
        let objpairs = ref [] in
          (* 1. Build object number, offset pairs *)
          xrefs_table_iter
            (fun n x ->
               match x with
               | XRefPlain (offset, gen) -> objpairs =| (n, (ref ToParse, gen))
               | _ -> ())
            xrefs;
            (* 2. Build the object map *)
            let objects =
              Pdf.objects_of_list (Some (get_object i xrefs)) !objpairs
            in
              (* 3. Build the Pdf putting the trailerdict in *)
              {(Pdf.empty ()) with
                 Pdf.objects = objects;
                 Pdf.trailerdict = trailerdict}
      in
      (* Move to the first xref section. *)
      find_eof i;
      backline i;
      (* Drop any initial contents which is not a digit - may occur if there is
      legitimate whitespace of if the PDF is malformed such that it has the
      startxref keyword and the byte offset on the same line. *)
      ignoreuntil false isdigit i;
      begin match takewhile isdigit (getuntil_white_or_delimiter i) with
      | [] -> raise (PDFReadError "Could not find xref pointer")
      | xrefchars -> xref := Int64.of_string (implode xrefchars);
      end;
      while not !got_all_xref_sections do
        i.seek_in (posofi64 !xref);
        (* Distinguish between xref table and xref stream. *)
        dropwhite i;
        let f_read_xref =
          if peek_char i = Some 'x'
            then read_xref
            else read_xref_stream
        in
          (* Read cross-reference table *)
          iter addref (f_read_xref i);
          (* It is now assumed that [i] is at the start of the trailer dictionary. *)
          let trailerdict_current =
            let lexemes =
              lex_object_at true i opt parse (lex_object i xrefs parse opt)
            in
              match parse lexemes with
              | (_, Dictionary d)
              | (_, Stream {contents = Dictionary d, _}) -> d
              | _ -> raise (PDFReadError "Malformed trailer")
          in
            begin
              if !first then
                begin
                  trailerdict := mergedict trailerdict_current !trailerdict;
                  clear first
                end;
              (* Do we have a /XRefStm to follow? *)
              begin match lookup "/XRefStm" trailerdict_current with
              | Some (Integer n) ->
                  i.seek_in (posofi n);
                  iter addref (read_xref_stream i);
              | _ -> ()
              end;
              (* Is there another to do? *)
              match lookup "/Prev" trailerdict_current with
              | None -> set got_all_xref_sections
              | Some (Integer n) -> xref := i64ofi n
              | _ -> raise (PDFReadError "Malformed trailer")
            end;
      done;
      let root =
        match lookup "/Root" !trailerdict with
        | Some (Indirect i) -> i
        | None -> raise (PDFReadError "No /Root entry")
        | _ -> raise (PDFReadError "Malformed /Root entry")
      in
        (* Print out the contents of the xref tables *)
        (*i Hashtbl.iter
          (fun k v -> Printf.printf "Object %i: %s\n" k (string_of_xref v))
          xrefs; i*)
        let getgen n =
          match xrefs_table_find xrefs n with
          | Some (XRefPlain (_, g)) -> g
          | Some (XRefStream _) -> 0
          | None -> raise Not_found
        in
        let objects_nonstream =
          let objnumbers = ref [] in
            xrefs_table_iter
              (fun n x ->
                 match x with
                 | XRefPlain (offset, gen) -> objnumbers =| n
                 | _ -> ())
              xrefs;
              map
                (if opt then
                   fun o ->
                     let num, parsed =
                       parse (lex_object i xrefs parse opt o)
                     in
                       num, (ref (Pdf.Parsed parsed), getgen o)
                   else
                     fun o -> o, (ref Pdf.ToParse, getgen o))
                !objnumbers
         and objects_stream =
           let streamones =
             map
               (function
                  | (n, XRefStream (s, i)) -> (n, s, i)
                  | _ -> raise (Assert_failure ("objects_stream", 0, 0)))
               (keep
                 (function (n, XRefStream _) -> true | _ -> false)
                 (list_of_hashtbl xrefs))
           in
             (*i iter
              (function (n, s, i) ->
                Printf.printf "STREAMONES: Obj %i, Stream %i, Index %i\n" n s i)
              streamones; i*)
             let cmp_objs (_, s, _) (_, s', _) = compare s s' in
               let sorted = List.sort cmp_objs streamones in
                 let collated = collate cmp_objs sorted in
                   let inputs_to_lex_stream_object =
                     map
                       (fun l ->
                         match hd l with (_, s, _) ->
                           s, map (fun (_, _, i) -> i) l)
                       collated
                   in
                     let outputs_from_lex_stream_object =
                       let partial = mkpartial (Pdf.Dictionary !trailerdict) in
                         map
                           (function (s, is) ->
                              lex_stream_object i xrefs parse opt s is user_pw partial (getgen s))
                           inputs_to_lex_stream_object
                     in
                       let object_lexemes_and_numbers =
                         flatten outputs_from_lex_stream_object
                       in
                         map
                           (fun (objnum, lexemes) ->
                              objnum,
                              (* Generation number of object in stream is always zero. *)
                              (ref (Pdf.Parsed (snd (parse_objnum objnum lexemes))), 0))
                           object_lexemes_and_numbers
         in
          (*i iter
            (fun (o, ({contents = Pdf.Parsed obj}, _)) ->
              Printf.printf "\n***Stream object %i\n" o;
              flprint (Pdfwrite.string_of_pdf obj);
            )
            objects_stream;
          iter
            (function (o, ({contents = Pdf.Parsed obj}, _)) ->
              Printf.printf "\n***NONStream object %i\n" o;
              flprint (Pdfwrite.string_of_pdf obj);
              | (o, ({contents = Pdf.ToParse}, _)) ->
              Printf.printf "\n***NONStream object toparse%i\n" o;

            )
            objects_nonstream; i*)
          objects_stream, objects_nonstream, root, trailerdict
    in
      let objects = objects_stream @ objects_nonstream in
        (* Fix Size entry and remove Prev and XRefStm *)
        let trailerdict' =
          Dictionary
            (add "/Size" (Integer (length objects))
              (remove "/Prev" (remove "/XRefStm" !trailerdict)))
        in
          let pdf = 
            {major = major;
             minor = minor;
             objects = Pdf.objects_of_list (Some (get_object i xrefs)) objects;
             root = root;
             trailerdict = trailerdict'}
          in
            Pdf.set_streamobjects pdf (map fst objects_stream);
            (*I iter (Printf.printf "%i ") (map fst objects_stream); i*)
            pdf

let default_upw = function
  | None -> ""
  | Some p -> p

(* \intf Read a PDF into memory, including its streams. *)
let pdf_of_channel upw ch =
  let upw = default_upw upw in
    read_pdf upw true (input_of_channel ch) 

(* \intf Same, but delay reading of streams. *)
let pdf_of_channel_lazy upw ch =
  let upw = default_upw upw in
  read_pdf upw false (input_of_channel ch)

(* \intf Similarly for inputs. *)
let pdf_of_input upw i =
  let upw = default_upw upw in
  read_pdf upw true i

(* \intf And lazy on inputs. *)
let pdf_of_input_lazy upw i =
  let upw = default_upw upw in
  read_pdf upw false i

(* \intf Read a whole PDF file into memory. Closes file. *)
let pdf_of_file upw f =
  (*i flprint (f ^ "\n"); i*)
  try 
    let fh = open_in_bin f in
      let pdf = pdf_of_channel upw fh in
        close_in fh;
        pdf
  with
    | (PDFError _ | PDFSemanticError _ | PDFReadError _) as e -> raise e
    (*IF-OCAML*)| Sys_error str -> raise (PDFError str) (*ENDIF-OCAML*)

let what_encryption pdf =
  if Pdfcrypt.is_encrypted pdf then
    let crypt, _, _, _, _ = Pdfcrypt.get_encryption_values pdf in
      match crypt with
      | Pdfcrypt.ARC4 (40, _) -> Some (Pdfwrite.PDF40bit)
      | Pdfcrypt.ARC4 (128, _) -> Some (Pdfwrite.PDF128bit)
      | Pdfcrypt.AESV2 ->
          let metadata =
            match Pdf.lookup_direct pdf "/Encrypt" pdf.Pdf.trailerdict with
            | Some encrypt_dict ->
                begin match Pdf.lookup_direct pdf "/EncryptMetadata" encrypt_dict with
                | Some (Pdf.Boolean false) -> false
                | _ -> true
                end
            | _ -> raise (Assert_failure ("what_encryption", 0, 0))
          in
            Some (Pdfwrite.AES128bit metadata)
      | _ -> None
  else
    None

let permissions pdf =
  if Pdfcrypt.is_encrypted pdf then
    let _, _, _, p, _ = Pdfcrypt.get_encryption_values pdf in
      Pdfcrypt.banlist_of_p p
  else
    []

let is_linearized i =
  try
    ignore (read_header i);
    let lexemes = lex_dictionary i in
      let _, parsed = parse lexemes in
        match Pdf.lookup_direct (Pdf.empty ()) "/Linearized" parsed with
        | Some (Pdf.Integer _) -> true
        | _ -> false
  with
    _ -> false