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
|
(*
* Copyright (C) 2006-2009 Citrix Systems Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation; version 2.1 only. with the special
* exception on linking described in file LICENSE.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
type cdrom_drive_status =
| NO_INFO
| NO_DISC
| TRAY_OPEN
| DRIVE_NOT_READY
| DISC_OK
let string_of_cdrom_drive_status = function
| NO_INFO -> "NO_INFO"
| NO_DISC -> "NO_DISC"
| TRAY_OPEN -> "TRAY_OPEN"
| DRIVE_NOT_READY -> "DRIVE_NOT_READY"
| DISC_OK -> "DISC_OK"
type cdrom_disc_status =
| DISC_NO_INFO
| DISC_NO_DISC
| AUDIO
| DATA_1
| DATA_2
| XA_2_1
| XA_2_2
| MIXED
let string_of_cdrom_disc_status = function
| DISC_NO_INFO -> "DISC_NO_INFO"
| DISC_NO_DISC -> "DISC_NO_DISC"
| AUDIO -> "AUDIO"
| DATA_1 -> "DATA_1"
| DATA_2 -> "DATA_2"
| XA_2_1 -> "XA_2_1"
| XA_2_2 -> "XA_2_2"
| MIXED -> "MIXED"
external _query_cdrom_drive_status : Unix.file_descr -> cdrom_drive_status = "stub_CDROM_DRIVE_STATUS"
external _query_cdrom_disc_status : Unix.file_descr -> cdrom_disc_status = "stub_CDROM_DISC_STATUS"
external _query_cdrom_mcn : Unix.file_descr -> string = "stub_CDROM_GET_MCN"
let with_cdrom (name: string) f =
let fd = Unix.openfile name [ Unix.O_RDONLY; Unix.O_NONBLOCK ] 0 in
try
let result = f fd in
Unix.close fd;
result
with e ->
Unix.close fd;
raise e
let query_cdrom_status (name: string) : (cdrom_drive_status * cdrom_disc_status) =
with_cdrom name (fun fd ->
let status = _query_cdrom_drive_status fd in
let disc = _query_cdrom_disc_status fd in
status, disc
)
let query_cdrom_drive_status (name: string) : cdrom_drive_status =
with_cdrom name _query_cdrom_drive_status
let query_cdrom_mcn (name: string) : string = with_cdrom name _query_cdrom_mcn
|
