diff --git a/.gitignore b/.gitignore index a305564..2eff48a 100644 --- a/.gitignore +++ b/.gitignore @@ -5,5 +5,4 @@ newlib-1.16.0.tar.gz lwip-1.3.0.tar.gz pciutils-2.2.9.tar.bz2 zlib-1.2.3.tar.gz -/ipxe-git-v1.0.0.tar.gz -/xen-4.1.3.tar.gz +/xen-4.2.0.tar.gz diff --git a/grub-ext4-support.patch b/grub-ext4-support.patch deleted file mode 100644 index c71cfe1..0000000 --- a/grub-ext4-support.patch +++ /dev/null @@ -1,474 +0,0 @@ -Index: grub-0.97/stage2/fsys_ext2fs.c -=================================================================== ---- grub-0.97.orig/stage2/fsys_ext2fs.c -+++ grub-0.97/stage2/fsys_ext2fs.c -@@ -41,6 +41,7 @@ typedef __signed__ short __s16; - typedef unsigned short __u16; - typedef __signed__ int __s32; - typedef unsigned int __u32; -+typedef unsigned long long __u64; - - /* - * Constants relative to the data blocks, from ext2_fs.h -@@ -51,7 +52,7 @@ typedef unsigned int __u32; - #define EXT2_TIND_BLOCK (EXT2_DIND_BLOCK + 1) - #define EXT2_N_BLOCKS (EXT2_TIND_BLOCK + 1) - --/* include/linux/ext2_fs.h */ -+/* lib/ext2fs/ext2_fs.h from e2fsprogs */ - struct ext2_super_block - { - __u32 s_inodes_count; /* Inodes count */ -@@ -61,9 +62,9 @@ struct ext2_super_block - __u32 s_free_inodes_count; /* Free inodes count */ - __u32 s_first_data_block; /* First Data Block */ - __u32 s_log_block_size; /* Block size */ -- __s32 s_log_frag_size; /* Fragment size */ -+ __s32 s_obso_log_frag_size; /* Obsoleted Fragment size */ - __u32 s_blocks_per_group; /* # Blocks per group */ -- __u32 s_frags_per_group; /* # Fragments per group */ -+ __u32 s_obso_frags_per_group; /* Obsoleted Fragments per group */ - __u32 s_inodes_per_group; /* # Inodes per group */ - __u32 s_mtime; /* Mount time */ - __u32 s_wtime; /* Write time */ -@@ -72,7 +73,7 @@ struct ext2_super_block - __u16 s_magic; /* Magic signature */ - __u16 s_state; /* File system state */ - __u16 s_errors; /* Behaviour when detecting errors */ -- __u16 s_pad; -+ __u16 s_minor_rev_level; /* minor revision level */ - __u32 s_lastcheck; /* time of last check */ - __u32 s_checkinterval; /* max. time between checks */ - __u32 s_creator_os; /* OS */ -@@ -119,15 +120,29 @@ struct ext2_super_block - __u32 s_hash_seed[4]; /* HTREE hash seed */ - __u8 s_def_hash_version; /* Default hash version to use */ - __u8 s_jnl_backup_type; /* Default type of journal backup */ -- __u16 s_reserved_word_pad; -+ __u16 s_desc_size; /* size of group descriptor */ - __u32 s_default_mount_opts; - __u32 s_first_meta_bg; /* First metablock group */ - __u32 s_mkfs_time; /* When the filesystem was created */ - __u32 s_jnl_blocks[17]; /* Backup of the journal inode */ -- __u32 s_reserved[172]; /* Padding to the end of the block */ -- }; -+ /* 64bit desc support valid if EXT4_FEATURE_INCOMPAT_64BIT */ -+ __u32 s_blocks_count_hi; /* Blocks count */ -+ __u32 s_r_blocks_count_hi; /* Reserved blocks count */ -+ __u32 s_free_blocks_count_hi; /* Free blocks count */ -+ __u16 s_min_extra_isize; /* All inodes have at least # bytes */ -+ __u16 s_max_extra_isize; /* New inodes should reverve # bytes */ -+ __u32 s_flags; /* Miscellaneous flags */ -+ __u16 s_raid_stride; /* Raid stride */ -+ __u16 s_mmp_interval; /* # seconds to wait MMP checking */ -+ __u64 s_mmp_block; /* Block for multi-mount protection */ -+ __u32 s_raid_stripe_width; /* Blocks on all data disks (N*stride)*/ -+ __u8 s_log_groups_per_flex;/* FLEX_BG group size*/ -+ __u8 s_reserved_char_pad; -+ __u16 s_reserved_pad; -+ __u32 s_reserved[162]; /* Padding to the end of the block */ -+}; - --struct ext2_group_desc -+struct ext4_group_desc - { - __u32 bg_block_bitmap; /* Blocks bitmap block */ - __u32 bg_inode_bitmap; /* Inodes bitmap block */ -@@ -135,8 +150,18 @@ struct ext2_group_desc - __u16 bg_free_blocks_count; /* Free blocks count */ - __u16 bg_free_inodes_count; /* Free inodes count */ - __u16 bg_used_dirs_count; /* Directories count */ -- __u16 bg_pad; -- __u32 bg_reserved[3]; -+ __u16 bg_flags; /* EXT4_BG_flags (INODE_UNINIT, etc) */ -+ __u32 bg_reserved[2]; /* Likely block/inode bitmap checksum */ -+ __u16 bg_itable_unused; /* Unused inodes count */ -+ __u16 bg_checksum; /* crc16(sb_uuid+group+desc) */ -+ __u32 bg_block_bitmap_hi; /* Blocks bitmap block MSB */ -+ __u32 bg_inode_bitmap_hi; /* Inodes bitmap block MSB */ -+ __u32 bg_inode_table_hi; /* Inodes table block MSB */ -+ __u16 bg_free_blocks_count_hi;/* Free blocks count MSB */ -+ __u16 bg_free_inodes_count_hi;/* Free inodes count MSB */ -+ __u16 bg_used_dirs_count_hi; /* Directories count MSB */ -+ __u16 bg_itable_unused_hi; /* Unused inodes count MSB */ -+ __u32 bg_reserved2[3]; - }; - - struct ext2_inode -@@ -174,22 +199,22 @@ struct ext2_inode - __u32 i_block[EXT2_N_BLOCKS]; /* 40: Pointers to blocks */ - __u32 i_version; /* File version (for NFS) */ - __u32 i_file_acl; /* File ACL */ -- __u32 i_dir_acl; /* Directory ACL */ -- __u32 i_faddr; /* Fragment address */ -+ __u32 i_size_high; -+ __u32 i_obso_faddr; /* Obsoleted fragment address */ - union - { - struct - { -- __u8 l_i_frag; /* Fragment number */ -- __u8 l_i_fsize; /* Fragment size */ -- __u16 i_pad1; -- __u32 l_i_reserved2[2]; -+ __u16 l_i_blocks_high; /* were l_i_reserved1 */ -+ __u16 l_i_file_acl_high; -+ __u16 l_i_uid_high; /* these 2 fields */ -+ __u16 l_i_gid_high; /* were reserved2[0] */ -+ __u32 l_i_reserved2; - } - linux2; - struct - { -- __u8 h_i_frag; /* Fragment number */ -- __u8 h_i_fsize; /* Fragment size */ -+ __u16 h_i_reserved1; /* Obsoleted fragment number/size which are removed in ext4 */ - __u16 h_i_mode_high; - __u16 h_i_uid_high; - __u16 h_i_gid_high; -@@ -198,16 +223,36 @@ struct ext2_inode - hurd2; - struct - { -- __u8 m_i_frag; /* Fragment number */ -- __u8 m_i_fsize; /* Fragment size */ -- __u16 m_pad1; -+ __u16 h_i_reserved1; /* Obsoleted fragment number/size which are removed in ext4 */ -+ __u16 m_i_file_acl_high; - __u32 m_i_reserved2[2]; - } - masix2; - } - osd2; /* OS dependent 2 */ -+ __u16 i_extra_isize; -+ __u16 i_pad1; -+ __u32 i_ctime_extra; /* extra Change time (nsec << 2 | epoch) */ -+ __u32 i_mtime_extra; /* extra Modification time(nsec << 2 | epoch) */ -+ __u32 i_atime_extra; /* extra Access time (nsec << 2 | epoch) */ -+ __u32 i_crtime; /* File Creation time */ -+ __u32 i_crtime_extra; /* extra FileCreationtime (nsec << 2 | epoch) */ -+ __u32 i_version_hi; /* high 32 bits for 64-bit version */ - }; - -+#define EXT4_FEATURE_INCOMPAT_EXTENTS 0x0040 /* extents support */ -+#define EXT4_FEATURE_INCOMPAT_64BIT 0x0080 /* grub not supported*/ -+#define EXT4_FEATURE_INCOMPAT_MMP 0x0100 -+#define EXT4_FEATURE_INCOMPAT_FLEX_BG 0x0200 -+ -+#define EXT4_HAS_INCOMPAT_FEATURE(sb,mask) \ -+ ( sb->s_feature_incompat & mask ) -+ -+#define EXT4_EXTENTS_FL 0x00080000 /* Inode uses extents */ -+#define EXT4_HUGE_FILE_FL 0x00040000 /* Set to each huge file */ -+ -+#define EXT4_MIN_DESC_SIZE 32 -+ - /* linux/limits.h */ - #define NAME_MAX 255 /* # chars in a file name */ - -@@ -225,6 +270,57 @@ struct ext2_dir_entry - char name[EXT2_NAME_LEN]; /* File name */ - }; - -+/* linux/ext4_fs_extents.h */ -+/* This is the extent on-disk structure. -+ * It's used at the bottom of the tree. -+ */ -+struct ext4_extent -+ { -+ __u32 ee_block; /* first logical block extent covers */ -+ __u16 ee_len; /* number of blocks covered by extent */ -+ __u16 ee_start_hi; /* high 16 bits of physical block */ -+ __u32 ee_start_lo; /* low 32 bits of physical block */ -+ }; -+ -+/* -+ * This is index on-disk structure. -+ * It's used at all the levels except the bottom. -+ */ -+struct ext4_extent_idx -+ { -+ __u32 ei_block; /* index covers logical blocks from 'block' */ -+ __u32 ei_leaf_lo; /* pointer to the physical block of the next * -+ * level. leaf or next index could be there */ -+ __u16 ei_leaf_hi; /* high 16 bits of physical block */ -+ __u16 ei_unused; -+ }; -+ -+/* -+ * Each block (leaves and indexes), even inode-stored has header. -+ */ -+struct ext4_extent_header -+ { -+ __u16 eh_magic; /* probably will support different formats */ -+ __u16 eh_entries; /* number of valid entries */ -+ __u16 eh_max; /* capacity of store in entries */ -+ __u16 eh_depth; /* has tree real underlying blocks? */ -+ __u32 eh_generation; /* generation of the tree */ -+ }; -+ -+#define EXT4_EXT_MAGIC (0xf30a) -+#define EXT_FIRST_EXTENT(__hdr__) \ -+ ((struct ext4_extent *) (((char *) (__hdr__)) + \ -+ sizeof(struct ext4_extent_header))) -+#define EXT_FIRST_INDEX(__hdr__) \ -+ ((struct ext4_extent_idx *) (((char *) (__hdr__)) + \ -+ sizeof(struct ext4_extent_header))) -+#define EXT_LAST_EXTENT(__hdr__) \ -+ (EXT_FIRST_EXTENT((__hdr__)) + (__u16)((__hdr__)->eh_entries) - 1) -+#define EXT_LAST_INDEX(__hdr__) \ -+ (EXT_FIRST_INDEX((__hdr__)) + (__u16)((__hdr__)->eh_entries) - 1) -+ -+ -+ - /* linux/ext2fs.h */ - /* - * EXT2_DIR_PAD defines the directory entries boundaries -@@ -271,8 +367,17 @@ struct ext2_dir_entry - /* kind of from ext2/super.c */ - #define EXT2_BLOCK_SIZE(s) (1 << EXT2_BLOCK_SIZE_BITS(s)) - /* linux/ext2fs.h */ -+/* sizeof(struct ext2_group_desc) is changed in ext4 -+ * in kernel code, ext2/3 uses sizeof(struct ext2_group_desc) to calculate -+ * number of desc per block, while ext4 uses superblock->s_desc_size in stead -+ * superblock->s_desc_size is not available in ext2/3 -+ * */ -+#define EXT2_DESC_SIZE(s) \ -+ (EXT4_HAS_INCOMPAT_FEATURE(s,EXT4_FEATURE_INCOMPAT_64BIT)? \ -+ s->s_desc_size : EXT4_MIN_DESC_SIZE) - #define EXT2_DESC_PER_BLOCK(s) \ -- (EXT2_BLOCK_SIZE(s) / sizeof (struct ext2_group_desc)) -+ (EXT2_BLOCK_SIZE(s) / EXT2_DESC_SIZE(s)) -+ - /* linux/stat.h */ - #define S_IFMT 00170000 - #define S_IFLNK 0120000 -@@ -434,6 +539,122 @@ ext2fs_block_map (int logical_block) - [logical_block & (EXT2_ADDR_PER_BLOCK (SUPERBLOCK) - 1)]; - } - -+/* extent binary search index -+ * find closest index in the current level extent tree -+ * kind of from ext4_ext_binsearch_idx in ext4/extents.c -+ */ -+static struct ext4_extent_idx* -+ext4_ext_binsearch_idx(struct ext4_extent_header* eh, int logical_block) -+{ -+ struct ext4_extent_idx *r, *l, *m; -+ l = EXT_FIRST_INDEX(eh) + 1; -+ r = EXT_LAST_INDEX(eh); -+ while (l <= r) -+ { -+ m = l + (r - l) / 2; -+ if (logical_block < m->ei_block) -+ r = m - 1; -+ else -+ l = m + 1; -+ } -+ return (struct ext4_extent_idx*)(l - 1); -+} -+ -+/* extent binary search -+ * find closest extent in the leaf level -+ * kind of from ext4_ext_binsearch in ext4/extents.c -+ */ -+static struct ext4_extent* -+ext4_ext_binsearch(struct ext4_extent_header* eh, int logical_block) -+{ -+ struct ext4_extent *r, *l, *m; -+ l = EXT_FIRST_EXTENT(eh) + 1; -+ r = EXT_LAST_EXTENT(eh); -+ while (l <= r) -+ { -+ m = l + (r - l) / 2; -+ if (logical_block < m->ee_block) -+ r = m - 1; -+ else -+ l = m + 1; -+ } -+ return (struct ext4_extent*)(l - 1); -+} -+ -+/* Maps extents enabled logical block into physical block via an inode. -+ * EXT4_HUGE_FILE_FL should be checked before calling this. -+ */ -+static int -+ext4fs_block_map (int logical_block) -+{ -+ struct ext4_extent_header *eh; -+ struct ext4_extent *ex, *extent; -+ struct ext4_extent_idx *ei, *index; -+ int depth; -+ int i; -+ -+#ifdef E2DEBUG -+ unsigned char *i; -+ for (i = (unsigned char *) INODE; -+ i < ((unsigned char *) INODE + sizeof (struct ext2_inode)); -+ i++) -+ { -+ printf ("%c", "0123456789abcdef"[*i >> 4]); -+ printf ("%c", "0123456789abcdef"[*i % 16]); -+ if (!((i + 1 - (unsigned char *) INODE) % 16)) -+ { -+ printf ("\n"); -+ } -+ else -+ { -+ printf (" "); -+ } -+ } -+ printf ("logical block %d\n", logical_block); -+#endif /* E2DEBUG */ -+ eh = (struct ext4_extent_header*)INODE->i_block; -+ if (eh->eh_magic != EXT4_EXT_MAGIC) -+ { -+ errnum = ERR_FSYS_CORRUPT; -+ return -1; -+ } -+ while((depth = eh->eh_depth) != 0) -+ { /* extent index */ -+ if (eh->eh_magic != EXT4_EXT_MAGIC) -+ { -+ errnum = ERR_FSYS_CORRUPT; -+ return -1; -+ } -+ ei = ext4_ext_binsearch_idx(eh, logical_block); -+ if (ei->ei_leaf_hi) -+ {/* 64bit physical block number not supported */ -+ errnum = ERR_FILELENGTH; -+ return -1; -+ } -+ if (!ext2_rdfsb(ei->ei_leaf_lo, DATABLOCK1)) -+ { -+ errnum = ERR_FSYS_CORRUPT; -+ return -1; -+ } -+ eh = (struct ext4_extent_header*)DATABLOCK1; -+ } -+ -+ /* depth==0, we come to the leaf */ -+ ex = ext4_ext_binsearch(eh, logical_block); -+ if (ex->ee_start_hi) -+ {/* 64bit physical block number not supported */ -+ errnum = ERR_FILELENGTH; -+ return -1; -+ } -+ if ((ex->ee_block + ex->ee_len) < logical_block) -+ { -+ errnum = ERR_FSYS_CORRUPT; -+ return -1; -+ } -+ return ex->ee_start_lo + logical_block - ex->ee_block; -+ -+} -+ - /* preconditions: all preconds of ext2fs_block_map */ - int - ext2fs_read (char *buf, int len) -@@ -468,6 +689,11 @@ ext2fs_read (char *buf, int len) - /* find the (logical) block component of our location */ - logical_block = filepos >> EXT2_BLOCK_SIZE_BITS (SUPERBLOCK); - offset = filepos & (EXT2_BLOCK_SIZE (SUPERBLOCK) - 1); -+ /* map extents enabled logical block number to physical fs on-disk block number */ -+ if (EXT4_HAS_INCOMPAT_FEATURE(SUPERBLOCK,EXT4_FEATURE_INCOMPAT_EXTENTS) -+ && INODE->i_flags & EXT4_EXTENTS_FL) -+ map = ext4fs_block_map (logical_block); -+ else - map = ext2fs_block_map (logical_block); - #ifdef E2DEBUG - printf ("map=%d\n", map); -@@ -552,7 +778,7 @@ ext2fs_dir (char *dirname) - int desc; /* index within that group */ - int ino_blk; /* fs pointer of the inode's information */ - int str_chk = 0; /* used to hold the results of a string compare */ -- struct ext2_group_desc *gdp; -+ struct ext4_group_desc *ext4_gdp; - struct ext2_inode *raw_inode; /* inode info corresponding to current_ino */ - - char linkbuf[PATH_MAX]; /* buffer for following symbolic links */ -@@ -598,8 +824,15 @@ ext2fs_dir (char *dirname) - { - return 0; - } -- gdp = GROUP_DESC; -- ino_blk = gdp[desc].bg_inode_table + -+ ext4_gdp = (struct ext4_group_desc *)( (__u8*)GROUP_DESC + -+ desc * EXT2_DESC_SIZE(SUPERBLOCK)); -+ if (EXT4_HAS_INCOMPAT_FEATURE(SUPERBLOCK, EXT4_FEATURE_INCOMPAT_64BIT) -+ && (! ext4_gdp->bg_inode_table_hi)) -+ {/* 64bit itable not supported */ -+ errnum = ERR_FILELENGTH; -+ return -1; -+ } -+ ino_blk = ext4_gdp->bg_inode_table + - (((current_ino - 1) % (SUPERBLOCK->s_inodes_per_group)) - >> log2 (EXT2_INODES_PER_BLOCK (SUPERBLOCK))); - #ifdef E2DEBUG -@@ -676,7 +909,10 @@ ext2fs_dir (char *dirname) - } - linkbuf[filemax + len] = '\0'; - -- /* Read the symlink data. */ -+ /* Read the symlink data. -+ * Slow symlink is extents enabled -+ * But since grub_read invokes ext2fs_read, nothing to change here -+ */ - if (! ext2_is_fast_symlink ()) - { - /* Read the necessary blocks, and reset the file pointer. */ -@@ -687,7 +923,9 @@ ext2fs_dir (char *dirname) - } - else - { -- /* Copy the data directly from the inode. */ -+ /* Copy the data directly from the inode. -+ * Fast symlink is not extents enabled -+ */ - len = filemax; - memmove (linkbuf, (char *) INODE->i_block, len); - } -@@ -721,6 +959,13 @@ ext2fs_dir (char *dirname) - errnum = ERR_BAD_FILETYPE; - return 0; - } -+ /* if file is too large, just stop and report an error*/ -+ if ( (INODE->i_flags & EXT4_HUGE_FILE_FL) && !(INODE->i_size_high)) -+ { -+ /* file too large, stop reading */ -+ errnum = ERR_FILELENGTH; -+ return 0; -+ } - - filemax = (INODE->i_size); - return 1; -@@ -775,17 +1020,28 @@ ext2fs_dir (char *dirname) - } - - /* else, find the (logical) block component of our location */ -+ /* ext4 logical block number the same as ext2/3 */ - blk = loc >> EXT2_BLOCK_SIZE_BITS (SUPERBLOCK); - - /* we know which logical block of the directory entry we are looking - for, now we have to translate that to the physical (fs) block on - the disk */ -+ /* map extents enabled logical block number to physical fs on-disk block number */ -+ if (EXT4_HAS_INCOMPAT_FEATURE(SUPERBLOCK,EXT4_FEATURE_INCOMPAT_EXTENTS) -+ && INODE->i_flags & EXT4_EXTENTS_FL) -+ map = ext4fs_block_map (blk); -+ else - map = ext2fs_block_map (blk); - #ifdef E2DEBUG - printf ("fs block=%d\n", map); - #endif /* E2DEBUG */ - mapblock2 = -1; -- if ((map < 0) || !ext2_rdfsb (map, DATABLOCK2)) -+ if (map < 0) -+ { -+ *rest = ch; -+ return 0; -+ } -+ if (!ext2_rdfsb (map, DATABLOCK2)) - { - errnum = ERR_FSYS_CORRUPT; - *rest = ch; diff --git a/pygrub.size.limits.patch b/pygrub.size.limits.patch deleted file mode 100644 index ce4e056..0000000 --- a/pygrub.size.limits.patch +++ /dev/null @@ -1,116 +0,0 @@ - -# HG changeset patch -# User M A Young -# Date 1341413174 -3600 -# Node ID 60f09d1ab1fe5dee87db1bf55c7479a5d71e85a5 -# Parent 42f76d536b116d2ebad1b6705ae51ecd171d2581 -pygrub: cope better with big files in the guest. - -Only read the first megabyte of a configuration file (grub etc.) and read the -kernel and ramdisk files from the guest in one megabyte pieces so pygrub -doesn't use a lot of memory if the files are large. With --not-really option -check that the chosen kernel and ramdisk files exist. If there are problems -writing the copy of the kernel or ramdisk, delete the copied files and exit in -case they have filled the filesystem. - -Signed-off-by: Michael Young -Acked-by: Matt Wilson -Acked-by: Ian Campbell -Acked-by: Ian Jackson -Committed-by: Ian Campbell - -diff -r 42f76d536b11 -r 60f09d1ab1fe tools/pygrub/src/pygrub ---- a/tools/pygrub/src/pygrub Tue Jul 03 13:39:01 2012 +0100 -+++ b/tools/pygrub/src/pygrub Wed Jul 04 15:46:14 2012 +0100 -@@ -28,6 +28,7 @@ import grub.LiloConf - import grub.ExtLinuxConf - - PYGRUB_VER = 0.6 -+FS_READ_MAX = 1024 * 1024 - - def enable_cursor(ison): - if ison: -@@ -448,7 +449,8 @@ class Grub: - if self.__dict__.get('cf', None) is None: - raise RuntimeError, "couldn't find bootloader config file in the image provided." - f = fs.open_file(self.cf.filename) -- buf = f.read() -+ # limit read size to avoid pathological cases -+ buf = f.read(FS_READ_MAX) - del f - self.cf.parse(buf) - -@@ -697,6 +699,37 @@ if __name__ == "__main__": - def usage(): - print >> sys.stderr, "Usage: %s [-q|--quiet] [-i|--interactive] [-n|--not-really] [--output=] [--kernel=] [--ramdisk=] [--args=] [--entry=] [--output-directory=] [--output-format=sxp|simple|simple0] " %(sys.argv[0],) - -+ def copy_from_image(fs, file_to_read, file_type, output_directory, -+ not_really): -+ if not_really: -+ if fs.file_exists(file_to_read): -+ return "<%s:%s>" % (file_type, file_to_read) -+ else: -+ sys.exit("The requested %s file does not exist" % file_type) -+ try: -+ datafile = fs.open_file(file_to_read) -+ except Exception, e: -+ print >>sys.stderr, e -+ sys.exit("Error opening %s in guest" % file_to_read) -+ (tfd, ret) = tempfile.mkstemp(prefix="boot_"+file_type+".", -+ dir=output_directory) -+ dataoff = 0 -+ while True: -+ data = datafile.read(FS_READ_MAX, dataoff) -+ if len(data) == 0: -+ os.close(tfd) -+ del datafile -+ return ret -+ try: -+ os.write(tfd, data) -+ except Exception, e: -+ print >>sys.stderr, e -+ os.close(tfd) -+ os.unlink(ret) -+ del datafile -+ sys.exit("Error writing temporary copy of "+file_type) -+ dataoff += len(data) -+ - try: - opts, args = getopt.gnu_getopt(sys.argv[1:], 'qinh::', - ["quiet", "interactive", "not-really", "help", -@@ -821,24 +854,18 @@ if __name__ == "__main__": - if not fs: - raise RuntimeError, "Unable to find partition containing kernel" - -- if not_really: -- bootcfg["kernel"] = "" % chosencfg["kernel"] -- else: -- data = fs.open_file(chosencfg["kernel"]).read() -- (tfd, bootcfg["kernel"]) = tempfile.mkstemp(prefix="boot_kernel.", -- dir=output_directory) -- os.write(tfd, data) -- os.close(tfd) -+ bootcfg["kernel"] = copy_from_image(fs, chosencfg["kernel"], "kernel", -+ output_directory, not_really) - - if chosencfg["ramdisk"]: -- if not_really: -- bootcfg["ramdisk"] = "" % chosencfg["ramdisk"] -- else: -- data = fs.open_file(chosencfg["ramdisk"],).read() -- (tfd, bootcfg["ramdisk"]) = tempfile.mkstemp( -- prefix="boot_ramdisk.", dir=output_directory) -- os.write(tfd, data) -- os.close(tfd) -+ try: -+ bootcfg["ramdisk"] = copy_from_image(fs, chosencfg["ramdisk"], -+ "ramdisk", output_directory, -+ not_really) -+ except: -+ if not not_really: -+ os.unlink(bootcfg["kernel"]) -+ raise - else: - initrd = None - - diff --git a/pygrubfix.patch b/pygrubfix.patch index e039369..2caa7ca 100644 --- a/pygrubfix.patch +++ b/pygrubfix.patch @@ -1,9 +1,9 @@ --- xen-4.1.0/tools/pygrub/src/pygrub.orig 2010-12-31 15:24:11.000000000 +0000 +++ xen-4.1.0/tools/pygrub/src/pygrub 2011-01-30 18:58:17.000000000 +0000 -@@ -96,6 +96,7 @@ - +@@ -97,6 +97,7 @@ fd = os.open(file, os.O_RDONLY) buf = os.read(fd, 512) + os.close(fd) + offzerocount = 0 for poff in (446, 462, 478, 494): # partition offsets diff --git a/qemu-xen-4.1-testing.git-3220480734832a148d26f7a81f90af61c2ecfdd9.patch b/qemu-xen-4.1-testing.git-3220480734832a148d26f7a81f90af61c2ecfdd9.patch deleted file mode 100644 index 3eb6824..0000000 --- a/qemu-xen-4.1-testing.git-3220480734832a148d26f7a81f90af61c2ecfdd9.patch +++ /dev/null @@ -1,123 +0,0 @@ -From 3220480734832a148d26f7a81f90af61c2ecfdd9 Mon Sep 17 00:00:00 2001 -From: Ian Campbell -Date: Wed, 5 Sep 2012 12:31:40 +0100 -Subject: [PATCH] console: bounds check whenever changing the cursor due to an escape code - -This is XSA-17 / CVE-2012-3515 - -Signed-off-by: Ian Campbell -(cherry picked from commit a56ae4b5069c7b23ee657b15f08443a9b14a8e7b) ---- - console.c | 57 ++++++++++++++++++++++++++++----------------------------- - 1 files changed, 28 insertions(+), 29 deletions(-) - -diff --git a/tools/ioemu-qemu-xen/console.c b/tools/ioemu-qemu-xen/console.c -index 5e6e3d0..9984d6f 100644 ---- a/tools/ioemu-qemu-xen/console.c -+++ b/tools/ioemu-qemu-xen/console.c -@@ -794,6 +794,26 @@ static void console_clear_xy(TextConsole *s, int x, int y) - update_xy(s, x, y); - } - -+/* set cursor, checking bounds */ -+static void set_cursor(TextConsole *s, int x, int y) -+{ -+ if (x < 0) { -+ x = 0; -+ } -+ if (y < 0) { -+ y = 0; -+ } -+ if (y >= s->height) { -+ y = s->height - 1; -+ } -+ if (x >= s->width) { -+ x = s->width - 1; -+ } -+ -+ s->x = x; -+ s->y = y; -+} -+ - static void console_putchar(TextConsole *s, int ch) - { - TextCell *c; -@@ -869,7 +889,8 @@ static void console_putchar(TextConsole *s, int ch) - s->esc_params[s->nb_esc_params] * 10 + ch - '0'; - } - } else { -- s->nb_esc_params++; -+ if (s->nb_esc_params < MAX_ESC_PARAMS) -+ s->nb_esc_params++; - if (ch == ';') - break; - #ifdef DEBUG_CONSOLE -@@ -883,59 +904,37 @@ static void console_putchar(TextConsole *s, int ch) - if (s->esc_params[0] == 0) { - s->esc_params[0] = 1; - } -- s->y -= s->esc_params[0]; -- if (s->y < 0) { -- s->y = 0; -- } -+ set_cursor(s, s->x, s->y - s->esc_params[0]); - break; - case 'B': - /* move cursor down */ - if (s->esc_params[0] == 0) { - s->esc_params[0] = 1; - } -- s->y += s->esc_params[0]; -- if (s->y >= s->height) { -- s->y = s->height - 1; -- } -+ set_cursor(s, s->x, s->y + s->esc_params[0]); - break; - case 'C': - /* move cursor right */ - if (s->esc_params[0] == 0) { - s->esc_params[0] = 1; - } -- s->x += s->esc_params[0]; -- if (s->x >= s->width) { -- s->x = s->width - 1; -- } -+ set_cursor(s, s->x + s->esc_params[0], s->y); - break; - case 'D': - /* move cursor left */ - if (s->esc_params[0] == 0) { - s->esc_params[0] = 1; - } -- s->x -= s->esc_params[0]; -- if (s->x < 0) { -- s->x = 0; -- } -+ set_cursor(s, s->x - s->esc_params[0], s->y); - break; - case 'G': - /* move cursor to column */ -- s->x = s->esc_params[0] - 1; -- if (s->x < 0) { -- s->x = 0; -- } -+ set_cursor(s, s->esc_params[0] - 1, s->y); - break; - case 'f': - case 'H': - /* move cursor to row, column */ -- s->x = s->esc_params[1] - 1; -- if (s->x < 0) { -- s->x = 0; -- } -- s->y = s->esc_params[0] - 1; -- if (s->y < 0) { -- s->y = 0; -- } -+ set_cursor(s, s->esc_params[1] - 1, s->esc_params[0] - 1); - break; - case 'J': - switch (s->esc_params[0]) { --- -1.7.2.5 - diff --git a/qemu-xen-4.1-testing.git-d7d453f51459b591faa96d1c123b5bfff7c5b6b6.patch b/qemu-xen-4.1-testing.git-d7d453f51459b591faa96d1c123b5bfff7c5b6b6.patch deleted file mode 100644 index f2f4ac7..0000000 --- a/qemu-xen-4.1-testing.git-d7d453f51459b591faa96d1c123b5bfff7c5b6b6.patch +++ /dev/null @@ -1,36 +0,0 @@ -From d7d453f51459b591faa96d1c123b5bfff7c5b6b6 Mon Sep 17 00:00:00 2001 -From: Ian Jackson -Date: Thu, 6 Sep 2012 17:05:30 +0100 -Subject: [PATCH] Disable qemu monitor by default. The qemu monitor is an overly - powerful feature which must be protected from untrusted (guest) - administrators. - -Neither xl nor xend expect qemu to produce this monitor unless it is -explicitly requested. - -This is a security problem, XSA-19. Previously it was CVE-2007-0998 -in Red Hat but we haven't dealt with it in upstream. We hope to have -a new CVE for it here but we don't have one yet. - -Signed-off-by: Ian Jackson -(cherry picked from commit bacc0d302445c75f18f4c826750fb5853b60e7ca) ---- - vl.c | 2 +- - 1 files changed, 1 insertions(+), 1 deletions(-) - -diff --git a/tools/ioemu-qemu-xen/vl.c b/tools/ioemu-qemu-xen/vl.c -index f07a659..686a9bd 100644 ---- a/tools/ioemu-qemu-xen/vl.c -+++ b/tools/ioemu-qemu-xen/vl.c -@@ -4910,7 +4910,7 @@ int main(int argc, char **argv, char **envp) - kernel_cmdline = ""; - cyls = heads = secs = 0; - translation = BIOS_ATA_TRANSLATION_AUTO; -- monitor_device = "vc:80Cx24C"; -+ monitor_device = "null"; - - serial_devices[0] = "vc:80Cx24C"; - for(i = 1; i < MAX_SERIAL_PORTS; i++) --- -1.7.2.5 - diff --git a/qemu-xen.tradonly.patch b/qemu-xen.tradonly.patch new file mode 100644 index 0000000..e39f3f3 --- /dev/null +++ b/qemu-xen.tradonly.patch @@ -0,0 +1,11 @@ +--- xen-4.2.0/tools/Makefile.orig 2012-05-27 20:29:17.372660785 +0100 ++++ xen-4.2.0/tools/Makefile 2012-05-27 20:38:24.066826167 +0100 +@@ -35,7 +35,7 @@ + # do not recurse in to a dir we are about to delete + ifneq "$(MAKECMDGOALS)" "distclean" + SUBDIRS-$(CONFIG_IOEMU) += qemu-xen-traditional-dir +-SUBDIRS-$(CONFIG_IOEMU) += qemu-xen-dir ++#SUBDIRS-$(CONFIG_IOEMU) += qemu-xen-dir + endif + + SUBDIRS-y += xenpmd diff --git a/sources b/sources index 5bf4371..e16cb6f 100644 --- a/sources +++ b/sources @@ -3,5 +3,4 @@ bf8f1f9e3ca83d732c00a79a6ef29bc4 newlib-1.16.0.tar.gz 36cc57650cffda9a0269493be2a169bb lwip-1.3.0.tar.gz cec05e7785497c5e19da2f114b934ffd pciutils-2.2.9.tar.bz2 debc62758716a169df9f62e6ab2bc634 zlib-1.2.3.tar.gz -fb7df96781d337899066d82059346885 ipxe-git-v1.0.0.tar.gz -bed929d5c5e5135cab40e2a6aab73fa0 xen-4.1.3.tar.gz +f4f217969afc38f09251039966d91a87 xen-4.2.0.tar.gz diff --git a/tmpfiles.d.xen.conf b/tmpfiles.d.xen.conf new file mode 100644 index 0000000..5041017 --- /dev/null +++ b/tmpfiles.d.xen.conf @@ -0,0 +1 @@ +d /run/xen 0755 root root - diff --git a/upstream-23936:cdb34816a40a-rework b/upstream-23936:cdb34816a40a-rework deleted file mode 100644 index aa5f40f..0000000 --- a/upstream-23936:cdb34816a40a-rework +++ /dev/null @@ -1,7924 +0,0 @@ -# HG changeset patch -# User Jon Ludlam -# Date 1317293932 -3600 -# Node ID ba4cba41f5550684719bc95a25f8f51b92fb604f -# Parent 7998217630e236639825d4db174c852cfa18e709 -[OCAML] Rename the ocamlfind packages - -This patch has the same effect as xen-unstable.hg -c/s 23936:cdb34816a40a. - -ocamlfind does not support namespaces, so to avoid -name clashes the ocamlfind package names have been -changed. Note that this does not change the names -of the actual modules themselves. - -xb becomes xenbus, xc becomes xenctrl, xl becomes xenlight, -xs becomes xenstore, eventchn becomes xeneventchn. - -Signed-off-by: Jon Ludlam - ---- a/tools/ocaml/libs/eventchn/META.in -+++ b/tools/ocaml/libs/eventchn/META.in -@@ -1,5 +1,5 @@ - version = "@VERSION@" - description = "Eventchn interface extension" - requires = "unix" --archive(byte) = "eventchn.cma" --archive(native) = "eventchn.cmxa" -+archive(byte) = "xeneventchn.cma" -+archive(native) = "xeneventchn.cmxa" ---- a/tools/ocaml/libs/eventchn/Makefile -+++ b/tools/ocaml/libs/eventchn/Makefile -@@ -2,9 +2,11 @@ - XEN_ROOT=$(TOPLEVEL)/../.. - include $(TOPLEVEL)/common.make - --OBJS = eventchn -+OBJS = xeneventchn - INTF = $(foreach obj, $(OBJS),$(obj).cmi) --LIBS = eventchn.cma eventchn.cmxa -+LIBS = xeneventchn.cma xeneventchn.cmxa -+ -+LIBS_xeneventchn = $(LDLIBS_libxenctrl) - - all: $(INTF) $(LIBS) $(PROGRAMS) - -@@ -12,20 +14,20 @@ - - libs: $(LIBS) - --eventchn_OBJS = $(OBJS) --eventchn_C_OBJS = eventchn_stubs -+xeneventchn_OBJS = $(OBJS) -+xeneventchn_C_OBJS = xeneventchn_stubs - --OCAML_LIBRARY = eventchn -+OCAML_LIBRARY = xeneventchn - - .PHONY: install - install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) -- ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn -- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore eventchn META $(INTF) $(LIBS) *.a *.so *.cmx -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn -+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xeneventchn META $(INTF) $(LIBS) *.a *.so *.cmx - - .PHONY: uninstall - uninstall: -- ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn - - include $(TOPLEVEL)/Makefile.rules - ---- a/tools/ocaml/libs/eventchn/eventchn.ml -+++ /dev/null -@@ -1,30 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- *) -- --exception Error of string -- --type handle -- --external init: unit -> handle = "stub_eventchn_init" --external fd: handle -> Unix.file_descr = "stub_eventchn_fd" --external notify: handle -> int -> unit = "stub_eventchn_notify" --external bind_interdomain: handle -> int -> int -> int = "stub_eventchn_bind_interdomain" --external bind_dom_exc_virq: handle -> int = "stub_eventchn_bind_dom_exc_virq" --external unbind: handle -> int -> unit = "stub_eventchn_unbind" --external pending: handle -> int = "stub_eventchn_pending" --external unmask: handle -> int -> unit = "stub_eventchn_unmask" -- --let _ = Callback.register_exception "eventchn.error" (Error "register_callback") ---- a/tools/ocaml/libs/eventchn/eventchn.mli -+++ /dev/null -@@ -1,31 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- *) -- --exception Error of string -- --type handle -- --external init : unit -> handle = "stub_eventchn_init" --external fd: handle -> Unix.file_descr = "stub_eventchn_fd" -- --external notify : handle -> int -> unit = "stub_eventchn_notify" --external bind_interdomain : handle -> int -> int -> int -- = "stub_eventchn_bind_interdomain" --external bind_dom_exc_virq : handle -> int = "stub_eventchn_bind_dom_exc_virq" --external unbind : handle -> int -> unit = "stub_eventchn_unbind" --external pending : handle -> int = "stub_eventchn_pending" --external unmask : handle -> int -> unit -- = "stub_eventchn_unmask" ---- a/tools/ocaml/libs/eventchn/eventchn_stubs.c -+++ /dev/null -@@ -1,143 +0,0 @@ --/* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- */ -- --#include --#include --#include --#include --#include --#include --#include --#include --#include --#include --#include -- --#define CAML_NAME_SPACE --#include --#include --#include --#include --#include --#include -- --#define _H(__h) ((xc_interface *)(__h)) -- --CAMLprim value stub_eventchn_init(void) --{ -- CAMLparam0(); -- CAMLlocal1(result); -- -- xc_interface *xce = xc_evtchn_open(NULL, XC_OPENFLAG_NON_REENTRANT); -- if (xce == NULL) -- caml_failwith("open failed"); -- -- result = (value)xce; -- CAMLreturn(result); --} -- --CAMLprim value stub_eventchn_fd(value xce) --{ -- CAMLparam1(xce); -- CAMLlocal1(result); -- int fd; -- -- fd = xc_evtchn_fd(_H(xce)); -- if (fd == -1) -- caml_failwith("evtchn fd failed"); -- -- result = Val_int(fd); -- -- CAMLreturn(result); --} -- --CAMLprim value stub_eventchn_notify(value xce, value port) --{ -- CAMLparam2(xce, port); -- int rc; -- -- rc = xc_evtchn_notify(_H(xce), Int_val(port)); -- if (rc == -1) -- caml_failwith("evtchn notify failed"); -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_eventchn_bind_interdomain(value xce, value domid, -- value remote_port) --{ -- CAMLparam3(xce, domid, remote_port); -- CAMLlocal1(port); -- evtchn_port_or_error_t rc; -- -- rc = xc_evtchn_bind_interdomain(_H(xce), Int_val(domid), Int_val(remote_port)); -- if (rc == -1) -- caml_failwith("evtchn bind_interdomain failed"); -- port = Val_int(rc); -- -- CAMLreturn(port); --} -- --CAMLprim value stub_eventchn_bind_dom_exc_virq(value xce) --{ -- CAMLparam1(xce); -- CAMLlocal1(port); -- evtchn_port_or_error_t rc; -- -- rc = xc_evtchn_bind_virq(_H(xce), VIRQ_DOM_EXC); -- if (rc == -1) -- caml_failwith("evtchn bind_dom_exc_virq failed"); -- port = Val_int(rc); -- -- CAMLreturn(port); --} -- --CAMLprim value stub_eventchn_unbind(value xce, value port) --{ -- CAMLparam2(xce, port); -- int rc; -- -- rc = xc_evtchn_unbind(_H(xce), Int_val(port)); -- if (rc == -1) -- caml_failwith("evtchn unbind failed"); -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_eventchn_pending(value xce) --{ -- CAMLparam1(xce); -- CAMLlocal1(result); -- evtchn_port_or_error_t port; -- -- port = xc_evtchn_pending(_H(xce)); -- if (port == -1) -- caml_failwith("evtchn pending failed"); -- result = Val_int(port); -- -- CAMLreturn(result); --} -- --CAMLprim value stub_eventchn_unmask(value xce, value _port) --{ -- CAMLparam2(xce, _port); -- evtchn_port_t port; -- -- port = Int_val(_port); -- if (xc_evtchn_unmask(_H(xce), port)) -- caml_failwith("evtchn unmask failed"); -- CAMLreturn(Val_unit); --} ---- /dev/null -+++ b/tools/ocaml/libs/eventchn/xeneventchn.ml -@@ -0,0 +1,30 @@ -+(* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ *) -+ -+exception Error of string -+ -+type handle -+ -+external init: unit -> handle = "stub_eventchn_init" -+external fd: handle -> Unix.file_descr = "stub_eventchn_fd" -+external notify: handle -> int -> unit = "stub_eventchn_notify" -+external bind_interdomain: handle -> int -> int -> int = "stub_eventchn_bind_interdomain" -+external bind_dom_exc_virq: handle -> int = "stub_eventchn_bind_dom_exc_virq" -+external unbind: handle -> int -> unit = "stub_eventchn_unbind" -+external pending: handle -> int = "stub_eventchn_pending" -+external unmask: handle -> int -> unit = "stub_eventchn_unmask" -+ -+let _ = Callback.register_exception "eventchn.error" (Error "register_callback") ---- /dev/null -+++ b/tools/ocaml/libs/eventchn/xeneventchn.mli -@@ -0,0 +1,31 @@ -+(* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ *) -+ -+exception Error of string -+ -+type handle -+ -+external init : unit -> handle = "stub_eventchn_init" -+external fd: handle -> Unix.file_descr = "stub_eventchn_fd" -+ -+external notify : handle -> int -> unit = "stub_eventchn_notify" -+external bind_interdomain : handle -> int -> int -> int -+ = "stub_eventchn_bind_interdomain" -+external bind_dom_exc_virq : handle -> int = "stub_eventchn_bind_dom_exc_virq" -+external unbind : handle -> int -> unit = "stub_eventchn_unbind" -+external pending : handle -> int = "stub_eventchn_pending" -+external unmask : handle -> int -> unit -+ = "stub_eventchn_unmask" ---- /dev/null -+++ b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c -@@ -0,0 +1,143 @@ -+/* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ */ -+ -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+ -+#define CAML_NAME_SPACE -+#include -+#include -+#include -+#include -+#include -+#include -+ -+#define _H(__h) ((xc_interface *)(__h)) -+ -+CAMLprim value stub_eventchn_init(void) -+{ -+ CAMLparam0(); -+ CAMLlocal1(result); -+ -+ xc_interface *xce = xc_evtchn_open(NULL, XC_OPENFLAG_NON_REENTRANT); -+ if (xce == NULL) -+ caml_failwith("open failed"); -+ -+ result = (value)xce; -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_eventchn_fd(value xce) -+{ -+ CAMLparam1(xce); -+ CAMLlocal1(result); -+ int fd; -+ -+ fd = xc_evtchn_fd(_H(xce)); -+ if (fd == -1) -+ caml_failwith("evtchn fd failed"); -+ -+ result = Val_int(fd); -+ -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_eventchn_notify(value xce, value port) -+{ -+ CAMLparam2(xce, port); -+ int rc; -+ -+ rc = xc_evtchn_notify(_H(xce), Int_val(port)); -+ if (rc == -1) -+ caml_failwith("evtchn notify failed"); -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_eventchn_bind_interdomain(value xce, value domid, -+ value remote_port) -+{ -+ CAMLparam3(xce, domid, remote_port); -+ CAMLlocal1(port); -+ evtchn_port_or_error_t rc; -+ -+ rc = xc_evtchn_bind_interdomain(_H(xce), Int_val(domid), Int_val(remote_port)); -+ if (rc == -1) -+ caml_failwith("evtchn bind_interdomain failed"); -+ port = Val_int(rc); -+ -+ CAMLreturn(port); -+} -+ -+CAMLprim value stub_eventchn_bind_dom_exc_virq(value xce) -+{ -+ CAMLparam1(xce); -+ CAMLlocal1(port); -+ evtchn_port_or_error_t rc; -+ -+ rc = xc_evtchn_bind_virq(_H(xce), VIRQ_DOM_EXC); -+ if (rc == -1) -+ caml_failwith("evtchn bind_dom_exc_virq failed"); -+ port = Val_int(rc); -+ -+ CAMLreturn(port); -+} -+ -+CAMLprim value stub_eventchn_unbind(value xce, value port) -+{ -+ CAMLparam2(xce, port); -+ int rc; -+ -+ rc = xc_evtchn_unbind(_H(xce), Int_val(port)); -+ if (rc == -1) -+ caml_failwith("evtchn unbind failed"); -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_eventchn_pending(value xce) -+{ -+ CAMLparam1(xce); -+ CAMLlocal1(result); -+ evtchn_port_or_error_t port; -+ -+ port = xc_evtchn_pending(_H(xce)); -+ if (port == -1) -+ caml_failwith("evtchn pending failed"); -+ result = Val_int(port); -+ -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_eventchn_unmask(value xce, value _port) -+{ -+ CAMLparam2(xce, _port); -+ evtchn_port_t port; -+ -+ port = Int_val(_port); -+ if (xc_evtchn_unmask(_H(xce), port)) -+ caml_failwith("evtchn unmask failed"); -+ CAMLreturn(Val_unit); -+} ---- a/tools/ocaml/libs/mmap/META.in -+++ b/tools/ocaml/libs/mmap/META.in -@@ -1,4 +1,4 @@ - version = "@VERSION@" - description = "Mmap interface extension" --archive(byte) = "mmap.cma" --archive(native) = "mmap.cmxa" -+archive(byte) = "xenmmap.cma" -+archive(native) = "xenmmap.cmxa" ---- a/tools/ocaml/libs/mmap/Makefile -+++ b/tools/ocaml/libs/mmap/Makefile -@@ -2,9 +2,9 @@ - XEN_ROOT=$(TOPLEVEL)/../.. - include $(TOPLEVEL)/common.make - --OBJS = mmap -+OBJS = xenmmap - INTF = $(foreach obj, $(OBJS),$(obj).cmi) --LIBS = mmap.cma mmap.cmxa -+LIBS = xenmmap.cma xenmmap.cmxa - - all: $(INTF) $(LIBS) $(PROGRAMS) - -@@ -12,19 +12,19 @@ - - libs: $(LIBS) - --mmap_OBJS = $(OBJS) --mmap_C_OBJS = mmap_stubs --OCAML_LIBRARY = mmap -+xenmmap_OBJS = $(OBJS) -+xenmmap_C_OBJS = xenmmap_stubs -+OCAML_LIBRARY = xenmmap - - .PHONY: install - install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) -- ocamlfind remove -destdir $(OCAMLDESTDIR) mmap -- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore mmap META $(INTF) $(LIBS) *.a *.so *.cmx -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenmmap -+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenmmap META $(INTF) $(LIBS) *.a *.so *.cmx - - .PHONY: uninstall - uninstall: -- ocamlfind remove -destdir $(OCAMLDESTDIR) mmap -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenmmap - - include $(TOPLEVEL)/Makefile.rules - ---- a/tools/ocaml/libs/mmap/mmap.ml -+++ /dev/null -@@ -1,31 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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 mmap_interface -- --type mmap_prot_flag = RDONLY | WRONLY | RDWR --type mmap_map_flag = SHARED | PRIVATE -- --(* mmap: fd -> prot_flag -> map_flag -> length -> offset -> interface *) --external mmap: Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -- -> int -> int -> mmap_interface = "stub_mmap_init" --external unmap: mmap_interface -> unit = "stub_mmap_final" --(* read: interface -> start -> length -> data *) --external read: mmap_interface -> int -> int -> string = "stub_mmap_read" --(* write: interface -> data -> start -> length -> unit *) --external write: mmap_interface -> string -> int -> int -> unit = "stub_mmap_write" --(* getpagesize: unit -> size of page *) --external getpagesize: unit -> int = "stub_mmap_getpagesize" ---- a/tools/ocaml/libs/mmap/mmap.mli -+++ /dev/null -@@ -1,28 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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 mmap_interface --type mmap_prot_flag = RDONLY | WRONLY | RDWR --type mmap_map_flag = SHARED | PRIVATE -- --external mmap : Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -> int -> int -- -> mmap_interface = "stub_mmap_init" --external unmap : mmap_interface -> unit = "stub_mmap_final" --external read : mmap_interface -> int -> int -> string = "stub_mmap_read" --external write : mmap_interface -> string -> int -> int -> unit -- = "stub_mmap_write" -- --external getpagesize : unit -> int = "stub_mmap_getpagesize" ---- a/tools/ocaml/libs/mmap/mmap_stubs.c -+++ /dev/null -@@ -1,136 +0,0 @@ --/* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- */ -- --#include --#include --#include --#include --#include --#include "mmap_stubs.h" -- --#include --#include --#include --#include --#include --#include -- --#define GET_C_STRUCT(a) ((struct mmap_interface *) a) -- --static int mmap_interface_init(struct mmap_interface *intf, -- int fd, int pflag, int mflag, -- int len, int offset) --{ -- intf->len = len; -- intf->addr = mmap(NULL, len, pflag, mflag, fd, offset); -- return (intf->addr == MAP_FAILED) ? errno : 0; --} -- --CAMLprim value stub_mmap_init(value fd, value pflag, value mflag, -- value len, value offset) --{ -- CAMLparam5(fd, pflag, mflag, len, offset); -- CAMLlocal1(result); -- int c_pflag, c_mflag; -- -- switch (Int_val(pflag)) { -- case 0: c_pflag = PROT_READ; break; -- case 1: c_pflag = PROT_WRITE; break; -- case 2: c_pflag = PROT_READ|PROT_WRITE; break; -- default: caml_invalid_argument("protectiontype"); -- } -- -- switch (Int_val(mflag)) { -- case 0: c_mflag = MAP_SHARED; break; -- case 1: c_mflag = MAP_PRIVATE; break; -- default: caml_invalid_argument("maptype"); -- } -- -- result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag); -- -- if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd), -- c_pflag, c_mflag, -- Int_val(len), Int_val(offset))) -- caml_failwith("mmap"); -- CAMLreturn(result); --} -- --CAMLprim value stub_mmap_final(value interface) --{ -- CAMLparam1(interface); -- struct mmap_interface *intf; -- -- intf = GET_C_STRUCT(interface); -- if (intf->addr != MAP_FAILED) -- munmap(intf->addr, intf->len); -- intf->addr = MAP_FAILED; -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_mmap_read(value interface, value start, value len) --{ -- CAMLparam3(interface, start, len); -- CAMLlocal1(data); -- struct mmap_interface *intf; -- int c_start; -- int c_len; -- -- c_start = Int_val(start); -- c_len = Int_val(len); -- intf = GET_C_STRUCT(interface); -- -- if (c_start > intf->len) -- caml_invalid_argument("start invalid"); -- if (c_start + c_len > intf->len) -- caml_invalid_argument("len invalid"); -- -- data = caml_alloc_string(c_len); -- memcpy((char *) data, intf->addr + c_start, c_len); -- -- CAMLreturn(data); --} -- --CAMLprim value stub_mmap_write(value interface, value data, -- value start, value len) --{ -- CAMLparam4(interface, data, start, len); -- struct mmap_interface *intf; -- int c_start; -- int c_len; -- -- c_start = Int_val(start); -- c_len = Int_val(len); -- intf = GET_C_STRUCT(interface); -- -- if (c_start > intf->len) -- caml_invalid_argument("start invalid"); -- if (c_start + c_len > intf->len) -- caml_invalid_argument("len invalid"); -- -- memcpy(intf->addr + c_start, (char *) data, c_len); -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_mmap_getpagesize(value unit) --{ -- CAMLparam1(unit); -- CAMLlocal1(data); -- -- data = Val_int(getpagesize()); -- CAMLreturn(data); --} ---- /dev/null -+++ b/tools/ocaml/libs/mmap/xenmmap.ml -@@ -0,0 +1,31 @@ -+(* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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 mmap_interface -+ -+type mmap_prot_flag = RDONLY | WRONLY | RDWR -+type mmap_map_flag = SHARED | PRIVATE -+ -+(* mmap: fd -> prot_flag -> map_flag -> length -> offset -> interface *) -+external mmap: Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -+ -> int -> int -> mmap_interface = "stub_mmap_init" -+external unmap: mmap_interface -> unit = "stub_mmap_final" -+(* read: interface -> start -> length -> data *) -+external read: mmap_interface -> int -> int -> string = "stub_mmap_read" -+(* write: interface -> data -> start -> length -> unit *) -+external write: mmap_interface -> string -> int -> int -> unit = "stub_mmap_write" -+(* getpagesize: unit -> size of page *) -+external getpagesize: unit -> int = "stub_mmap_getpagesize" ---- /dev/null -+++ b/tools/ocaml/libs/mmap/xenmmap.mli -@@ -0,0 +1,28 @@ -+(* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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 mmap_interface -+type mmap_prot_flag = RDONLY | WRONLY | RDWR -+type mmap_map_flag = SHARED | PRIVATE -+ -+external mmap : Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -> int -> int -+ -> mmap_interface = "stub_mmap_init" -+external unmap : mmap_interface -> unit = "stub_mmap_final" -+external read : mmap_interface -> int -> int -> string = "stub_mmap_read" -+external write : mmap_interface -> string -> int -> int -> unit -+ = "stub_mmap_write" -+ -+external getpagesize : unit -> int = "stub_mmap_getpagesize" ---- /dev/null -+++ b/tools/ocaml/libs/mmap/xenmmap_stubs.c -@@ -0,0 +1,136 @@ -+/* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ */ -+ -+#include -+#include -+#include -+#include -+#include -+#include "mmap_stubs.h" -+ -+#include -+#include -+#include -+#include -+#include -+#include -+ -+#define GET_C_STRUCT(a) ((struct mmap_interface *) a) -+ -+static int mmap_interface_init(struct mmap_interface *intf, -+ int fd, int pflag, int mflag, -+ int len, int offset) -+{ -+ intf->len = len; -+ intf->addr = mmap(NULL, len, pflag, mflag, fd, offset); -+ return (intf->addr == MAP_FAILED) ? errno : 0; -+} -+ -+CAMLprim value stub_mmap_init(value fd, value pflag, value mflag, -+ value len, value offset) -+{ -+ CAMLparam5(fd, pflag, mflag, len, offset); -+ CAMLlocal1(result); -+ int c_pflag, c_mflag; -+ -+ switch (Int_val(pflag)) { -+ case 0: c_pflag = PROT_READ; break; -+ case 1: c_pflag = PROT_WRITE; break; -+ case 2: c_pflag = PROT_READ|PROT_WRITE; break; -+ default: caml_invalid_argument("protectiontype"); -+ } -+ -+ switch (Int_val(mflag)) { -+ case 0: c_mflag = MAP_SHARED; break; -+ case 1: c_mflag = MAP_PRIVATE; break; -+ default: caml_invalid_argument("maptype"); -+ } -+ -+ result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag); -+ -+ if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd), -+ c_pflag, c_mflag, -+ Int_val(len), Int_val(offset))) -+ caml_failwith("mmap"); -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_mmap_final(value interface) -+{ -+ CAMLparam1(interface); -+ struct mmap_interface *intf; -+ -+ intf = GET_C_STRUCT(interface); -+ if (intf->addr != MAP_FAILED) -+ munmap(intf->addr, intf->len); -+ intf->addr = MAP_FAILED; -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_mmap_read(value interface, value start, value len) -+{ -+ CAMLparam3(interface, start, len); -+ CAMLlocal1(data); -+ struct mmap_interface *intf; -+ int c_start; -+ int c_len; -+ -+ c_start = Int_val(start); -+ c_len = Int_val(len); -+ intf = GET_C_STRUCT(interface); -+ -+ if (c_start > intf->len) -+ caml_invalid_argument("start invalid"); -+ if (c_start + c_len > intf->len) -+ caml_invalid_argument("len invalid"); -+ -+ data = caml_alloc_string(c_len); -+ memcpy((char *) data, intf->addr + c_start, c_len); -+ -+ CAMLreturn(data); -+} -+ -+CAMLprim value stub_mmap_write(value interface, value data, -+ value start, value len) -+{ -+ CAMLparam4(interface, data, start, len); -+ struct mmap_interface *intf; -+ int c_start; -+ int c_len; -+ -+ c_start = Int_val(start); -+ c_len = Int_val(len); -+ intf = GET_C_STRUCT(interface); -+ -+ if (c_start > intf->len) -+ caml_invalid_argument("start invalid"); -+ if (c_start + c_len > intf->len) -+ caml_invalid_argument("len invalid"); -+ -+ memcpy(intf->addr + c_start, (char *) data, c_len); -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_mmap_getpagesize(value unit) -+{ -+ CAMLparam1(unit); -+ CAMLlocal1(data); -+ -+ data = Val_int(getpagesize()); -+ CAMLreturn(data); -+} ---- a/tools/ocaml/libs/xb/META.in -+++ b/tools/ocaml/libs/xb/META.in -@@ -1,5 +1,5 @@ - version = "@VERSION@" - description = "XenBus Interface" --requires = "unix,mmap" --archive(byte) = "xb.cma" --archive(native) = "xb.cmxa" -+requires = "unix,xenmmap" -+archive(byte) = "xenbus.cma" -+archive(native) = "xenbus.cmxa" ---- a/tools/ocaml/libs/xb/Makefile -+++ b/tools/ocaml/libs/xb/Makefile -@@ -4,6 +4,7 @@ - - CFLAGS += -I../mmap - OCAMLINCLUDE += -I ../mmap -+OCAMLOPTFLAGS += -for-pack Xenbus - - .NOTPARALLEL: - # Ocaml is such a PITA! -@@ -13,7 +14,7 @@ - PRELIBS = $(foreach obj, $(PREOBJS),$(obj).cmo) $(foreach obj,$(PREOJBS),$(obj).cmx) - OBJS = op partial packet xs_ring xb - INTF = op.cmi packet.cmi xb.cmi --LIBS = xb.cma xb.cmxa -+LIBS = xenbus.cma xenbus.cmxa - - ALL_OCAML_OBJS = $(OBJS) $(PREOJBS) - -@@ -23,22 +24,30 @@ - - libs: $(LIBS) - --xb_OBJS = $(OBJS) --xb_C_OBJS = xs_ring_stubs xb_stubs --OCAML_LIBRARY = xb -+xenbus_OBJS = xenbus -+xenbus_C_OBJS = xs_ring_stubs xenbus_stubs -+OCAML_LIBRARY = xenbus -+ -+xenbus.cmx : $(foreach obj, $(OBJS), $(obj).cmx) -+ $(E) " CMX $@" -+ $(OCAMLOPT) -pack -o $@ $^ -+ -+xenbus.cmo : $(foreach obj, $(OBJS), $(obj).cmo) -+ $(E) " CMO $@" -+ $(OCAMLC) -pack -o $@ $^ - - %.mli: %.ml - $(E) " MLI $@" -- $(Q)$(OCAMLC) -i $< $o -+ $(Q)$(OCAMLC) $(OCAMLINCLUDE) -i $< $o - - .PHONY: install - install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) -- ocamlfind remove -destdir $(OCAMLDESTDIR) xb -- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xb META $(INTF) $(LIBS) *.a *.so *.cmx -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus -+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenbus META $(LIBS) xenbus.cmi xenbus.cmx *.a *.so - - .PHONY: uninstall - uninstall: -- ocamlfind remove -destdir $(OCAMLDESTDIR) xb -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus - - include $(TOPLEVEL)/Makefile.rules ---- a/tools/ocaml/libs/xb/xb.ml -+++ b/tools/ocaml/libs/xb/xb.ml -@@ -24,7 +24,7 @@ - - type backend_mmap = - { -- mmap: Mmap.mmap_interface; (* mmaped interface = xs_ring *) -+ mmap: Xenmmap.mmap_interface; (* mmaped interface = xs_ring *) - eventchn_notify: unit -> unit; (* function to notify through eventchn *) - mutable work_again: bool; - } -@@ -34,7 +34,7 @@ - fd: Unix.file_descr; - } - --type backend = Fd of backend_fd | Mmap of backend_mmap -+type backend = Fd of backend_fd | Xenmmap of backend_mmap - - type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string - -@@ -68,7 +68,7 @@ - let read con s len = - match con.backend with - | Fd backfd -> read_fd backfd con s len -- | Mmap backmmap -> read_mmap backmmap con s len -+ | Xenmmap backmmap -> read_mmap backmmap con s len - - let write_fd back con s len = - Unix.write back.fd s 0 len -@@ -82,7 +82,7 @@ - let write con s len = - match con.backend with - | Fd backfd -> write_fd backfd con s len -- | Mmap backmmap -> write_mmap backmmap con s len -+ | Xenmmap backmmap -> write_mmap backmmap con s len - - let output con = - (* get the output string from a string_of(packet) or partial_out *) -@@ -145,7 +145,7 @@ - let open_fd fd = newcon (Fd { fd = fd; }) - - let open_mmap mmap notifyfct = -- newcon (Mmap { -+ newcon (Xenmmap { - mmap = mmap; - eventchn_notify = notifyfct; - work_again = false; }) -@@ -153,12 +153,12 @@ - let close con = - match con.backend with - | Fd backend -> Unix.close backend.fd -- | Mmap backend -> Mmap.unmap backend.mmap -+ | Xenmmap backend -> Xenmmap.unmap backend.mmap - - let is_fd con = - match con.backend with - | Fd _ -> true -- | Mmap _ -> false -+ | Xenmmap _ -> false - - let is_mmap con = not (is_fd con) - -@@ -176,14 +176,14 @@ - let has_more_input con = - match con.backend with - | Fd _ -> false -- | Mmap backend -> backend.work_again -+ | Xenmmap backend -> backend.work_again - - let is_selectable con = - match con.backend with - | Fd _ -> true -- | Mmap _ -> false -+ | Xenmmap _ -> false - - let get_fd con = - match con.backend with - | Fd backend -> backend.fd -- | Mmap _ -> raise (Failure "get_fd") -+ | Xenmmap _ -> raise (Failure "get_fd") ---- a/tools/ocaml/libs/xb/xb.mli -+++ b/tools/ocaml/libs/xb/xb.mli -@@ -1,83 +1,103 @@ --module Op: --sig -- type operation = Op.operation = -- | Debug -- | Directory -- | Read -- | Getperms -- | Watch -- | Unwatch -- | Transaction_start -- | Transaction_end -- | Introduce -- | Release -- | Getdomainpath -- | Write -- | Mkdir -- | Rm -- | Setperms -- | Watchevent -- | Error -- | Isintroduced -- | Resume -- | Set_target -- | Restrict -- val to_string : operation -> string --end -- --module Packet: --sig -- type t -- -- exception Error of string -- exception DataError of string -- -- val create : int -> int -> Op.operation -> string -> t -- val unpack : t -> int * int * Op.operation * string -- -- val get_tid : t -> int -- val get_ty : t -> Op.operation -- val get_data : t -> string -- val get_rid: t -> int --end -- -+module Op : -+ sig -+ type operation = -+ Op.operation = -+ Debug -+ | Directory -+ | Read -+ | Getperms -+ | Watch -+ | Unwatch -+ | Transaction_start -+ | Transaction_end -+ | Introduce -+ | Release -+ | Getdomainpath -+ | Write -+ | Mkdir -+ | Rm -+ | Setperms -+ | Watchevent -+ | Error -+ | Isintroduced -+ | Resume -+ | Set_target -+ | Restrict -+ val operation_c_mapping : operation array -+ val size : int -+ val offset_pq : int -+ val operation_c_mapping_pq : 'a array -+ val size_pq : int -+ val array_search : 'a -> 'a array -> int -+ val of_cval : int -> operation -+ val to_cval : operation -> int -+ val to_string : operation -> string -+ end -+module Packet : -+ sig -+ type t = -+ Packet.t = { -+ tid : int; -+ rid : int; -+ ty : Op.operation; -+ data : string; -+ } -+ exception Error of string -+ exception DataError of string -+ external string_of_header : int -> int -> int -> int -> string -+ = "stub_string_of_header" -+ val create : int -> int -> Op.operation -> string -> t -+ val of_partialpkt : Partial.pkt -> t -+ val to_string : t -> string -+ val unpack : t -> int * int * Op.operation * string -+ val get_tid : t -> int -+ val get_ty : t -> Op.operation -+ val get_data : t -> string -+ val get_rid : t -> int -+ end - exception End_of_file - exception Eagain - exception Noent - exception Invalid -- --type t -- --(** queue a packet into the output queue for later sending *) -+type backend_mmap = { -+ mmap : Xenmmap.mmap_interface; -+ eventchn_notify : unit -> unit; -+ mutable work_again : bool; -+} -+type backend_fd = { fd : Unix.file_descr; } -+type backend = Fd of backend_fd | Xenmmap of backend_mmap -+type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string -+type t = { -+ backend : backend; -+ pkt_in : Packet.t Queue.t; -+ pkt_out : Packet.t Queue.t; -+ mutable partial_in : partial_buf; -+ mutable partial_out : string; -+} -+val init_partial_in : unit -> partial_buf - val queue : t -> Packet.t -> unit -- --(** process the output queue, return if a packet has been totally sent *) -+val read_fd : backend_fd -> 'a -> string -> int -> int -+val read_mmap : backend_mmap -> 'a -> string -> int -> int -+val read : t -> string -> int -> int -+val write_fd : backend_fd -> 'a -> string -> int -> int -+val write_mmap : backend_mmap -> 'a -> string -> int -> int -+val write : t -> string -> int -> int - val output : t -> bool -- --(** process the input queue, return if a packet has been totally received *) - val input : t -> bool -- --(** create new connection using a fd interface *) -+val newcon : backend -> t - val open_fd : Unix.file_descr -> t --(** create new connection using a mmap intf and a function to notify eventchn *) --val open_mmap : Mmap.mmap_interface -> (unit -> unit) -> t -- --(* close a connection *) -+val open_mmap : Xenmmap.mmap_interface -> (unit -> unit) -> t - val close : t -> unit -- - val is_fd : t -> bool - val is_mmap : t -> bool -- - val output_len : t -> int - val has_new_output : t -> bool - val has_old_output : t -> bool - val has_output : t -> bool - val peek_output : t -> Packet.t -- - val input_len : t -> int - val has_in_packet : t -> bool - val get_in_packet : t -> Packet.t - val has_more_input : t -> bool -- - val is_selectable : t -> bool - val get_fd : t -> Unix.file_descr ---- a/tools/ocaml/libs/xb/xb_stubs.c -+++ /dev/null -@@ -1,71 +0,0 @@ --/* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- */ -- --#include --#include --#include --#include --#include -- --#include --#include --#include --#include --#include --#include -- --#include --#include -- --CAMLprim value stub_header_size(void) --{ -- CAMLparam0(); -- CAMLreturn(Val_int(sizeof(struct xsd_sockmsg))); --} -- --CAMLprim value stub_header_of_string(value s) --{ -- CAMLparam1(s); -- CAMLlocal1(ret); -- struct xsd_sockmsg *hdr; -- -- if (caml_string_length(s) != sizeof(struct xsd_sockmsg)) -- caml_failwith("xb header incomplete"); -- ret = caml_alloc_tuple(4); -- hdr = (struct xsd_sockmsg *) String_val(s); -- Store_field(ret, 0, Val_int(hdr->tx_id)); -- Store_field(ret, 1, Val_int(hdr->req_id)); -- Store_field(ret, 2, Val_int(hdr->type)); -- Store_field(ret, 3, Val_int(hdr->len)); -- CAMLreturn(ret); --} -- --CAMLprim value stub_string_of_header(value tid, value rid, value ty, value len) --{ -- CAMLparam4(tid, rid, ty, len); -- CAMLlocal1(ret); -- struct xsd_sockmsg xsd = { -- .type = Int_val(ty), -- .tx_id = Int_val(tid), -- .req_id = Int_val(rid), -- .len = Int_val(len), -- }; -- -- ret = caml_alloc_string(sizeof(struct xsd_sockmsg)); -- memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg)); -- -- CAMLreturn(ret); --} ---- /dev/null -+++ b/tools/ocaml/libs/xb/xenbus_stubs.c -@@ -0,0 +1,71 @@ -+/* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ */ -+ -+#include -+#include -+#include -+#include -+#include -+ -+#include -+#include -+#include -+#include -+#include -+#include -+ -+#include -+#include -+ -+CAMLprim value stub_header_size(void) -+{ -+ CAMLparam0(); -+ CAMLreturn(Val_int(sizeof(struct xsd_sockmsg))); -+} -+ -+CAMLprim value stub_header_of_string(value s) -+{ -+ CAMLparam1(s); -+ CAMLlocal1(ret); -+ struct xsd_sockmsg *hdr; -+ -+ if (caml_string_length(s) != sizeof(struct xsd_sockmsg)) -+ caml_failwith("xb header incomplete"); -+ ret = caml_alloc_tuple(4); -+ hdr = (struct xsd_sockmsg *) String_val(s); -+ Store_field(ret, 0, Val_int(hdr->tx_id)); -+ Store_field(ret, 1, Val_int(hdr->req_id)); -+ Store_field(ret, 2, Val_int(hdr->type)); -+ Store_field(ret, 3, Val_int(hdr->len)); -+ CAMLreturn(ret); -+} -+ -+CAMLprim value stub_string_of_header(value tid, value rid, value ty, value len) -+{ -+ CAMLparam4(tid, rid, ty, len); -+ CAMLlocal1(ret); -+ struct xsd_sockmsg xsd = { -+ .type = Int_val(ty), -+ .tx_id = Int_val(tid), -+ .req_id = Int_val(rid), -+ .len = Int_val(len), -+ }; -+ -+ ret = caml_alloc_string(sizeof(struct xsd_sockmsg)); -+ memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg)); -+ -+ CAMLreturn(ret); -+} ---- a/tools/ocaml/libs/xb/xs_ring.ml -+++ b/tools/ocaml/libs/xb/xs_ring.ml -@@ -14,5 +14,5 @@ - * GNU Lesser General Public License for more details. - *) - --external read: Mmap.mmap_interface -> string -> int -> int = "ml_interface_read" --external write: Mmap.mmap_interface -> string -> int -> int = "ml_interface_write" -+external read: Xenmmap.mmap_interface -> string -> int -> int = "ml_interface_read" -+external write: Xenmmap.mmap_interface -> string -> int -> int = "ml_interface_write" ---- a/tools/ocaml/libs/xc/META.in -+++ b/tools/ocaml/libs/xc/META.in -@@ -1,5 +1,5 @@ - version = "@VERSION@" - description = "Xen Control Interface" --requires = "mmap,uuid" --archive(byte) = "xc.cma" --archive(native) = "xc.cmxa" -+requires = "xenmmap,uuid" -+archive(byte) = "xenctrl.cma" -+archive(native) = "xenctrl.cmxa" ---- a/tools/ocaml/libs/xc/Makefile -+++ b/tools/ocaml/libs/xc/Makefile -@@ -5,16 +5,16 @@ - CFLAGS += -I../mmap -I./ -I$(XEN_ROOT)/tools/libxc - OCAMLINCLUDE += -I ../mmap -I ../uuid -I $(XEN_ROOT)/tools/libxc - --OBJS = xc --INTF = xc.cmi --LIBS = xc.cma xc.cmxa -+OBJS = xenctrl -+INTF = xenctrl.cmi -+LIBS = xenctrl.cma xenctrl.cmxa - --LIBS_xc = -L$(XEN_ROOT)/tools/libxc -lxenctrl -lxenguest -+LIBS_xenctrl = -L$(XEN_ROOT)/tools/libxc -lxenctrl -lxenguest - --xc_OBJS = $(OBJS) --xc_C_OBJS = xc_stubs -+xenctrl_OBJS = $(OBJS) -+xenctrl_C_OBJS = xenctrl_stubs - --OCAML_LIBRARY = xc -+OCAML_LIBRARY = xenctrl - - all: $(INTF) $(LIBS) - -@@ -23,11 +23,11 @@ - .PHONY: install - install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) -- ocamlfind remove -destdir $(OCAMLDESTDIR) xc -- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xc META $(INTF) $(LIBS) *.a *.so *.cmx -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl -+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenctrl META $(INTF) $(LIBS) *.a *.so *.cmx - - .PHONY: uninstall - uninstall: -- ocamlfind remove -destdir $(OCAMLDESTDIR) xc -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl - - include $(TOPLEVEL)/Makefile.rules ---- a/tools/ocaml/libs/xc/xc.ml -+++ /dev/null -@@ -1,326 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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 domid = int -- --(* ** xenctrl.h ** *) -- --type vcpuinfo = --{ -- online: bool; -- blocked: bool; -- running: bool; -- cputime: int64; -- cpumap: int32; --} -- --type domaininfo = --{ -- domid : domid; -- dying : bool; -- shutdown : bool; -- paused : bool; -- blocked : bool; -- running : bool; -- hvm_guest : bool; -- shutdown_code : int; -- total_memory_pages: nativeint; -- max_memory_pages : nativeint; -- shared_info_frame : int64; -- cpu_time : int64; -- nr_online_vcpus : int; -- max_vcpu_id : int; -- ssidref : int32; -- handle : int array; --} -- --type sched_control = --{ -- weight : int; -- cap : int; --} -- --type physinfo_cap_flag = -- | CAP_HVM -- | CAP_DirectIO -- --type physinfo = --{ -- threads_per_core : int; -- cores_per_socket : int; -- nr_cpus : int; -- max_node_id : int; -- cpu_khz : int; -- total_pages : nativeint; -- free_pages : nativeint; -- scrub_pages : nativeint; -- (* XXX hw_cap *) -- capabilities : physinfo_cap_flag list; --} -- --type version = --{ -- major : int; -- minor : int; -- extra : string; --} -- -- --type compile_info = --{ -- compiler : string; -- compile_by : string; -- compile_domain : string; -- compile_date : string; --} -- --type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt -- --type domain_create_flag = CDF_HVM | CDF_HAP -- --exception Error of string -- --type handle -- --(* this is only use by coredumping *) --external sizeof_core_header: unit -> int -- = "stub_sizeof_core_header" --external sizeof_vcpu_guest_context: unit -> int -- = "stub_sizeof_vcpu_guest_context" --external sizeof_xen_pfn: unit -> int = "stub_sizeof_xen_pfn" --(* end of use *) -- --external interface_open: unit -> handle = "stub_xc_interface_open" --external interface_close: handle -> unit = "stub_xc_interface_close" -- --external is_fake: unit -> bool = "stub_xc_interface_is_fake" -- --let with_intf f = -- let xc = interface_open () in -- let r = try f xc with exn -> interface_close xc; raise exn in -- interface_close xc; -- r -- --external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid -- = "stub_xc_domain_create" -- --let domain_create handle n flags uuid = -- _domain_create handle n flags (Uuid.int_array_of_uuid uuid) -- --external _domain_sethandle: handle -> domid -> int array -> unit -- = "stub_xc_domain_sethandle" -- --let domain_sethandle handle n uuid = -- _domain_sethandle handle n (Uuid.int_array_of_uuid uuid) -- --external domain_max_vcpus: handle -> domid -> int -> unit -- = "stub_xc_domain_max_vcpus" -- --external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause" --external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause" --external domain_resume_fast: handle -> domid -> unit = "stub_xc_domain_resume_fast" --external domain_destroy: handle -> domid -> unit = "stub_xc_domain_destroy" -- --external domain_shutdown: handle -> domid -> shutdown_reason -> unit -- = "stub_xc_domain_shutdown" -- --external _domain_getinfolist: handle -> domid -> int -> domaininfo list -- = "stub_xc_domain_getinfolist" -- --let domain_getinfolist handle first_domain = -- let nb = 2 in -- let last_domid l = (List.hd l).domid + 1 in -- let rec __getlist from = -- let l = _domain_getinfolist handle from nb in -- (if List.length l = nb then __getlist (last_domid l) else []) @ l -- in -- List.rev (__getlist first_domain) -- --external domain_getinfo: handle -> domid -> domaininfo= "stub_xc_domain_getinfo" -- --external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo -- = "stub_xc_vcpu_getinfo" -- --external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit -- = "stub_xc_domain_ioport_permission" --external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit -- = "stub_xc_domain_iomem_permission" --external domain_irq_permission: handle -> domid -> int -> bool -> unit -- = "stub_xc_domain_irq_permission" -- --external vcpu_affinity_set: handle -> domid -> int -> bool array -> unit -- = "stub_xc_vcpu_setaffinity" --external vcpu_affinity_get: handle -> domid -> int -> bool array -- = "stub_xc_vcpu_getaffinity" -- --external vcpu_context_get: handle -> domid -> int -> string -- = "stub_xc_vcpu_context_get" -- --external sched_id: handle -> int = "stub_xc_sched_id" -- --external sched_credit_domain_set: handle -> domid -> sched_control -> unit -- = "stub_sched_credit_domain_set" --external sched_credit_domain_get: handle -> domid -> sched_control -- = "stub_sched_credit_domain_get" -- --external shadow_allocation_set: handle -> domid -> int -> unit -- = "stub_shadow_allocation_set" --external shadow_allocation_get: handle -> domid -> int -- = "stub_shadow_allocation_get" -- --external evtchn_alloc_unbound: handle -> domid -> domid -> int -- = "stub_xc_evtchn_alloc_unbound" --external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset" -- --external readconsolering: handle -> string = "stub_xc_readconsolering" -- --external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys" --external physinfo: handle -> physinfo = "stub_xc_physinfo" --external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info" -- --external domain_setmaxmem: handle -> domid -> int64 -> unit -- = "stub_xc_domain_setmaxmem" --external domain_set_memmap_limit: handle -> domid -> int64 -> unit -- = "stub_xc_domain_set_memmap_limit" --external domain_memory_increase_reservation: handle -> domid -> int64 -> unit -- = "stub_xc_domain_memory_increase_reservation" -- --external domain_set_machine_address_size: handle -> domid -> int -> unit -- = "stub_xc_domain_set_machine_address_size" --external domain_get_machine_address_size: handle -> domid -> int -- = "stub_xc_domain_get_machine_address_size" -- --external domain_cpuid_set: handle -> domid -> (int64 * (int64 option)) -- -> string option array -- -> string option array -- = "stub_xc_domain_cpuid_set" --external domain_cpuid_apply_policy: handle -> domid -> unit -- = "stub_xc_domain_cpuid_apply_policy" --external cpuid_check: handle -> (int64 * (int64 option)) -> string option array -> (bool * string option array) -- = "stub_xc_cpuid_check" -- --external map_foreign_range: handle -> domid -> int -- -> nativeint -> Mmap.mmap_interface -- = "stub_map_foreign_range" -- --external domain_get_pfn_list: handle -> domid -> nativeint -> nativeint array -- = "stub_xc_domain_get_pfn_list" -- --external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit -- = "stub_xc_domain_assign_device" --external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit -- = "stub_xc_domain_deassign_device" --external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool -- = "stub_xc_domain_test_assign_device" -- --external version: handle -> version = "stub_xc_version_version" --external version_compile_info: handle -> compile_info -- = "stub_xc_version_compile_info" --external version_changeset: handle -> string = "stub_xc_version_changeset" --external version_capabilities: handle -> string = -- "stub_xc_version_capabilities" -- --external watchdog : handle -> int -> int32 -> int -- = "stub_xc_watchdog" -- --(* core dump structure *) --type core_magic = Magic_hvm | Magic_pv -- --type core_header = { -- xch_magic: core_magic; -- xch_nr_vcpus: int; -- xch_nr_pages: nativeint; -- xch_index_offset: int64; -- xch_ctxt_offset: int64; -- xch_pages_offset: int64; --} -- --external marshall_core_header: core_header -> string = "stub_marshall_core_header" -- --(* coredump *) --let coredump xch domid fd = -- let dump s = -- let wd = Unix.write fd s 0 (String.length s) in -- if wd <> String.length s then -- failwith "error while writing"; -- in -- -- let info = domain_getinfo xch domid in -- -- let nrpages = info.total_memory_pages in -- let ctxt = Array.make info.max_vcpu_id None in -- let nr_vcpus = ref 0 in -- for i = 0 to info.max_vcpu_id - 1 -- do -- ctxt.(i) <- try -- let v = vcpu_context_get xch domid i in -- incr nr_vcpus; -- Some v -- with _ -> None -- done; -- -- (* FIXME page offset if not rounded to sup *) -- let page_offset = -- Int64.add -- (Int64.of_int (sizeof_core_header () + -- (sizeof_vcpu_guest_context () * !nr_vcpus))) -- (Int64.of_nativeint ( -- Nativeint.mul -- (Nativeint.of_int (sizeof_xen_pfn ())) -- nrpages) -- ) -- in -- -- let header = { -- xch_magic = if info.hvm_guest then Magic_hvm else Magic_pv; -- xch_nr_vcpus = !nr_vcpus; -- xch_nr_pages = nrpages; -- xch_ctxt_offset = Int64.of_int (sizeof_core_header ()); -- xch_index_offset = Int64.of_int (sizeof_core_header () -- + sizeof_vcpu_guest_context ()); -- xch_pages_offset = page_offset; -- } in -- -- dump (marshall_core_header header); -- for i = 0 to info.max_vcpu_id - 1 -- do -- match ctxt.(i) with -- | None -> () -- | Some ctxt_i -> dump ctxt_i -- done; -- let pfns = domain_get_pfn_list xch domid nrpages in -- if Array.length pfns <> Nativeint.to_int nrpages then -- failwith "could not get the page frame list"; -- -- let page_size = Mmap.getpagesize () in -- for i = 0 to Nativeint.to_int nrpages - 1 -- do -- let page = map_foreign_range xch domid page_size pfns.(i) in -- let data = Mmap.read page 0 page_size in -- Mmap.unmap page; -- dump data -- done -- --(* ** Misc ** *) -- --(** -- Convert the given number of pages to an amount in KiB, rounded up. -- *) --external pages_to_kib : int64 -> int64 = "stub_pages_to_kib" --let pages_to_mib pages = Int64.div (pages_to_kib pages) 1024L -- --let _ = Callback.register_exception "xc.error" (Error "register_callback") ---- a/tools/ocaml/libs/xc/xc.mli -+++ /dev/null -@@ -1,184 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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 domid = int --type vcpuinfo = { -- online : bool; -- blocked : bool; -- running : bool; -- cputime : int64; -- cpumap : int32; --} --type domaininfo = { -- domid : domid; -- dying : bool; -- shutdown : bool; -- paused : bool; -- blocked : bool; -- running : bool; -- hvm_guest : bool; -- shutdown_code : int; -- total_memory_pages : nativeint; -- max_memory_pages : nativeint; -- shared_info_frame : int64; -- cpu_time : int64; -- nr_online_vcpus : int; -- max_vcpu_id : int; -- ssidref : int32; -- handle : int array; --} --type sched_control = { weight : int; cap : int; } --type physinfo_cap_flag = CAP_HVM | CAP_DirectIO --type physinfo = { -- threads_per_core : int; -- cores_per_socket : int; -- nr_cpus : int; -- max_node_id : int; -- cpu_khz : int; -- total_pages : nativeint; -- free_pages : nativeint; -- scrub_pages : nativeint; -- capabilities : physinfo_cap_flag list; --} --type version = { major : int; minor : int; extra : string; } --type compile_info = { -- compiler : string; -- compile_by : string; -- compile_domain : string; -- compile_date : string; --} --type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt -- --type domain_create_flag = CDF_HVM | CDF_HAP -- --exception Error of string --type handle --external sizeof_core_header : unit -> int = "stub_sizeof_core_header" --external sizeof_vcpu_guest_context : unit -> int -- = "stub_sizeof_vcpu_guest_context" --external sizeof_xen_pfn : unit -> int = "stub_sizeof_xen_pfn" --external interface_open : unit -> handle = "stub_xc_interface_open" --external is_fake : unit -> bool = "stub_xc_interface_is_fake" --external interface_close : handle -> unit = "stub_xc_interface_close" --val with_intf : (handle -> 'a) -> 'a --external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid -- = "stub_xc_domain_create" --val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t -> domid --external _domain_sethandle : handle -> domid -> int array -> unit -- = "stub_xc_domain_sethandle" --val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit --external domain_max_vcpus : handle -> domid -> int -> unit -- = "stub_xc_domain_max_vcpus" --external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause" --external domain_unpause : handle -> domid -> unit = "stub_xc_domain_unpause" --external domain_resume_fast : handle -> domid -> unit -- = "stub_xc_domain_resume_fast" --external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy" --external domain_shutdown : handle -> domid -> shutdown_reason -> unit -- = "stub_xc_domain_shutdown" --external _domain_getinfolist : handle -> domid -> int -> domaininfo list -- = "stub_xc_domain_getinfolist" --val domain_getinfolist : handle -> domid -> domaininfo list --external domain_getinfo : handle -> domid -> domaininfo -- = "stub_xc_domain_getinfo" --external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo -- = "stub_xc_vcpu_getinfo" --external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit -- = "stub_xc_domain_ioport_permission" --external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit -- = "stub_xc_domain_iomem_permission" --external domain_irq_permission: handle -> domid -> int -> bool -> unit -- = "stub_xc_domain_irq_permission" --external vcpu_affinity_set : handle -> domid -> int -> bool array -> unit -- = "stub_xc_vcpu_setaffinity" --external vcpu_affinity_get : handle -> domid -> int -> bool array -- = "stub_xc_vcpu_getaffinity" --external vcpu_context_get : handle -> domid -> int -> string -- = "stub_xc_vcpu_context_get" --external sched_id : handle -> int = "stub_xc_sched_id" --external sched_credit_domain_set : handle -> domid -> sched_control -> unit -- = "stub_sched_credit_domain_set" --external sched_credit_domain_get : handle -> domid -> sched_control -- = "stub_sched_credit_domain_get" --external shadow_allocation_set : handle -> domid -> int -> unit -- = "stub_shadow_allocation_set" --external shadow_allocation_get : handle -> domid -> int -- = "stub_shadow_allocation_get" --external evtchn_alloc_unbound : handle -> domid -> domid -> int -- = "stub_xc_evtchn_alloc_unbound" --external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset" --external readconsolering : handle -> string = "stub_xc_readconsolering" --external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys" --external physinfo : handle -> physinfo = "stub_xc_physinfo" --external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info" --external domain_setmaxmem : handle -> domid -> int64 -> unit -- = "stub_xc_domain_setmaxmem" --external domain_set_memmap_limit : handle -> domid -> int64 -> unit -- = "stub_xc_domain_set_memmap_limit" --external domain_memory_increase_reservation : -- handle -> domid -> int64 -> unit -- = "stub_xc_domain_memory_increase_reservation" --external map_foreign_range : -- handle -> domid -> int -> nativeint -> Mmap.mmap_interface -- = "stub_map_foreign_range" --external domain_get_pfn_list : -- handle -> domid -> nativeint -> nativeint array -- = "stub_xc_domain_get_pfn_list" -- --external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit -- = "stub_xc_domain_assign_device" --external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit -- = "stub_xc_domain_deassign_device" --external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool -- = "stub_xc_domain_test_assign_device" -- --external version : handle -> version = "stub_xc_version_version" --external version_compile_info : handle -> compile_info -- = "stub_xc_version_compile_info" --external version_changeset : handle -> string = "stub_xc_version_changeset" --external version_capabilities : handle -> string -- = "stub_xc_version_capabilities" --type core_magic = Magic_hvm | Magic_pv --type core_header = { -- xch_magic : core_magic; -- xch_nr_vcpus : int; -- xch_nr_pages : nativeint; -- xch_index_offset : int64; -- xch_ctxt_offset : int64; -- xch_pages_offset : int64; --} --external marshall_core_header : core_header -> string -- = "stub_marshall_core_header" --val coredump : handle -> domid -> Unix.file_descr -> unit --external pages_to_kib : int64 -> int64 = "stub_pages_to_kib" --val pages_to_mib : int64 -> int64 --external watchdog : handle -> int -> int32 -> int -- = "stub_xc_watchdog" -- --external domain_set_machine_address_size: handle -> domid -> int -> unit -- = "stub_xc_domain_set_machine_address_size" --external domain_get_machine_address_size: handle -> domid -> int -- = "stub_xc_domain_get_machine_address_size" -- --external domain_cpuid_set: handle -> domid -> (int64 * (int64 option)) -- -> string option array -- -> string option array -- = "stub_xc_domain_cpuid_set" --external domain_cpuid_apply_policy: handle -> domid -> unit -- = "stub_xc_domain_cpuid_apply_policy" --external cpuid_check: handle -> (int64 * (int64 option)) -> string option array -> (bool * string option array) -- = "stub_xc_cpuid_check" -- ---- a/tools/ocaml/libs/xc/xc_stubs.c -+++ /dev/null -@@ -1,1161 +0,0 @@ --/* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- */ -- --#define _XOPEN_SOURCE 600 --#include --#include -- --#define CAML_NAME_SPACE --#include --#include --#include --#include --#include -- --#include --#include --#include -- --#include -- --#include "mmap_stubs.h" -- --#define PAGE_SHIFT 12 --#define PAGE_SIZE (1UL << PAGE_SHIFT) --#define PAGE_MASK (~(PAGE_SIZE-1)) -- --#define _H(__h) ((xc_interface *)(__h)) --#define _D(__d) ((uint32_t)Int_val(__d)) -- --#define Val_none (Val_int(0)) -- --#define string_of_option_array(array, index) \ -- ((Field(array, index) == Val_none) ? NULL : String_val(Field(Field(array, index), 0))) -- --/* maybe here we should check the range of the input instead of blindly -- * casting it to uint32 */ --#define cpuid_input_of_val(i1, i2, input) \ -- i1 = (uint32_t) Int64_val(Field(input, 0)); \ -- i2 = ((Field(input, 1) == Val_none) ? 0xffffffff : (uint32_t) Int64_val(Field(Field(input, 1), 0))); -- --#define ERROR_STRLEN 1024 --void failwith_xc(xc_interface *xch) --{ -- static char error_str[ERROR_STRLEN]; -- if (xch) { -- const xc_error *error = xc_get_last_error(xch); -- if (error->code == XC_ERROR_NONE) -- snprintf(error_str, ERROR_STRLEN, "%d: %s", errno, strerror(errno)); -- else -- snprintf(error_str, ERROR_STRLEN, "%d: %s: %s", -- error->code, -- xc_error_code_to_desc(error->code), -- error->message); -- } else { -- snprintf(error_str, ERROR_STRLEN, "Unable to open XC interface"); -- } -- caml_raise_with_string(*caml_named_value("xc.error"), error_str); --} -- --CAMLprim value stub_sizeof_core_header(value unit) --{ -- CAMLparam1(unit); -- CAMLreturn(Val_int(sizeof(struct xc_core_header))); --} -- --CAMLprim value stub_sizeof_vcpu_guest_context(value unit) --{ -- CAMLparam1(unit); -- CAMLreturn(Val_int(sizeof(struct vcpu_guest_context))); --} -- --CAMLprim value stub_sizeof_xen_pfn(value unit) --{ -- CAMLparam1(unit); -- CAMLreturn(Val_int(sizeof(xen_pfn_t))); --} -- --#define XC_CORE_MAGIC 0xF00FEBED --#define XC_CORE_MAGIC_HVM 0xF00FEBEE -- --CAMLprim value stub_marshall_core_header(value header) --{ -- CAMLparam1(header); -- CAMLlocal1(s); -- struct xc_core_header c_header; -- -- c_header.xch_magic = (Field(header, 0)) -- ? XC_CORE_MAGIC -- : XC_CORE_MAGIC_HVM; -- c_header.xch_nr_vcpus = Int_val(Field(header, 1)); -- c_header.xch_nr_pages = Nativeint_val(Field(header, 2)); -- c_header.xch_ctxt_offset = Int64_val(Field(header, 3)); -- c_header.xch_index_offset = Int64_val(Field(header, 4)); -- c_header.xch_pages_offset = Int64_val(Field(header, 5)); -- -- s = caml_alloc_string(sizeof(c_header)); -- memcpy(String_val(s), (char *) &c_header, sizeof(c_header)); -- CAMLreturn(s); --} -- --CAMLprim value stub_xc_interface_open(void) --{ -- CAMLparam0(); -- xc_interface *xch; -- xch = xc_interface_open(NULL, NULL, XC_OPENFLAG_NON_REENTRANT); -- if (xch == NULL) -- failwith_xc(NULL); -- CAMLreturn((value)xch); --} -- -- --CAMLprim value stub_xc_interface_is_fake(void) --{ -- CAMLparam0(); -- int is_fake = xc_interface_is_fake(); -- CAMLreturn(Val_int(is_fake)); --} -- --CAMLprim value stub_xc_interface_close(value xch) --{ -- CAMLparam1(xch); -- -- // caml_enter_blocking_section(); -- xc_interface_close(_H(xch)); -- // caml_leave_blocking_section(); -- -- CAMLreturn(Val_unit); --} -- --static int domain_create_flag_table[] = { -- XEN_DOMCTL_CDF_hvm_guest, -- XEN_DOMCTL_CDF_hap, --}; -- --CAMLprim value stub_xc_domain_create(value xch, value ssidref, -- value flags, value handle) --{ -- CAMLparam4(xch, ssidref, flags, handle); -- -- uint32_t domid = 0; -- xen_domain_handle_t h = { 0 }; -- int result; -- int i; -- uint32_t c_ssidref = Int32_val(ssidref); -- unsigned int c_flags = 0; -- value l; -- -- if (Wosize_val(handle) != 16) -- caml_invalid_argument("Handle not a 16-integer array"); -- -- for (i = 0; i < sizeof(h); i++) { -- h[i] = Int_val(Field(handle, i)) & 0xff; -- } -- -- for (l = flags; l != Val_none; l = Field(l, 1)) { -- int v = Int_val(Field(l, 0)); -- c_flags |= domain_create_flag_table[v]; -- } -- -- // caml_enter_blocking_section(); -- result = xc_domain_create(_H(xch), c_ssidref, h, c_flags, &domid); -- // caml_leave_blocking_section(); -- -- if (result < 0) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_int(domid)); --} -- --CAMLprim value stub_xc_domain_max_vcpus(value xch, value domid, -- value max_vcpus) --{ -- CAMLparam3(xch, domid, max_vcpus); -- int r; -- -- r = xc_domain_max_vcpus(_H(xch), _D(domid), Int_val(max_vcpus)); -- if (r) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- -- --value stub_xc_domain_sethandle(value xch, value domid, value handle) --{ -- CAMLparam3(xch, domid, handle); -- xen_domain_handle_t h = { 0 }; -- int i; -- -- if (Wosize_val(handle) != 16) -- caml_invalid_argument("Handle not a 16-integer array"); -- -- for (i = 0; i < sizeof(h); i++) { -- h[i] = Int_val(Field(handle, i)) & 0xff; -- } -- -- i = xc_domain_sethandle(_H(xch), _D(domid), h); -- if (i) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- --static value dom_op(value xch, value domid, int (*fn)(xc_interface *, uint32_t)) --{ -- CAMLparam2(xch, domid); -- -- uint32_t c_domid = _D(domid); -- -- // caml_enter_blocking_section(); -- int result = fn(_H(xch), c_domid); -- // caml_leave_blocking_section(); -- if (result) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_pause(value xch, value domid) --{ -- return dom_op(xch, domid, xc_domain_pause); --} -- -- --CAMLprim value stub_xc_domain_unpause(value xch, value domid) --{ -- return dom_op(xch, domid, xc_domain_unpause); --} -- --CAMLprim value stub_xc_domain_destroy(value xch, value domid) --{ -- return dom_op(xch, domid, xc_domain_destroy); --} -- --CAMLprim value stub_xc_domain_resume_fast(value xch, value domid) --{ -- CAMLparam2(xch, domid); -- -- uint32_t c_domid = _D(domid); -- -- // caml_enter_blocking_section(); -- int result = xc_domain_resume(_H(xch), c_domid, 1); -- // caml_leave_blocking_section(); -- if (result) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_shutdown(value xch, value domid, value reason) --{ -- CAMLparam3(xch, domid, reason); -- int ret; -- -- ret = xc_domain_shutdown(_H(xch), _D(domid), Int_val(reason)); -- if (ret < 0) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- --static value alloc_domaininfo(xc_domaininfo_t * info) --{ -- CAMLparam0(); -- CAMLlocal2(result, tmp); -- int i; -- -- result = caml_alloc_tuple(16); -- -- Store_field(result, 0, Val_int(info->domain)); -- Store_field(result, 1, Val_bool(info->flags & XEN_DOMINF_dying)); -- Store_field(result, 2, Val_bool(info->flags & XEN_DOMINF_shutdown)); -- Store_field(result, 3, Val_bool(info->flags & XEN_DOMINF_paused)); -- Store_field(result, 4, Val_bool(info->flags & XEN_DOMINF_blocked)); -- Store_field(result, 5, Val_bool(info->flags & XEN_DOMINF_running)); -- Store_field(result, 6, Val_bool(info->flags & XEN_DOMINF_hvm_guest)); -- Store_field(result, 7, Val_int((info->flags >> XEN_DOMINF_shutdownshift) -- & XEN_DOMINF_shutdownmask)); -- Store_field(result, 8, caml_copy_nativeint(info->tot_pages)); -- Store_field(result, 9, caml_copy_nativeint(info->max_pages)); -- Store_field(result, 10, caml_copy_int64(info->shared_info_frame)); -- Store_field(result, 11, caml_copy_int64(info->cpu_time)); -- Store_field(result, 12, Val_int(info->nr_online_vcpus)); -- Store_field(result, 13, Val_int(info->max_vcpu_id)); -- Store_field(result, 14, caml_copy_int32(info->ssidref)); -- -- tmp = caml_alloc_small(16, 0); -- for (i = 0; i < 16; i++) { -- Field(tmp, i) = Val_int(info->handle[i]); -- } -- -- Store_field(result, 15, tmp); -- -- CAMLreturn(result); --} -- --CAMLprim value stub_xc_domain_getinfolist(value xch, value first_domain, value nb) --{ -- CAMLparam3(xch, first_domain, nb); -- CAMLlocal2(result, temp); -- xc_domaininfo_t * info; -- int i, ret, toalloc, retval; -- unsigned int c_max_domains; -- uint32_t c_first_domain; -- -- /* get the minimum number of allocate byte we need and bump it up to page boundary */ -- toalloc = (sizeof(xc_domaininfo_t) * Int_val(nb)) | 0xfff; -- ret = posix_memalign((void **) ((void *) &info), 4096, toalloc); -- if (ret) -- caml_raise_out_of_memory(); -- -- result = temp = Val_emptylist; -- -- c_first_domain = _D(first_domain); -- c_max_domains = Int_val(nb); -- // caml_enter_blocking_section(); -- retval = xc_domain_getinfolist(_H(xch), c_first_domain, -- c_max_domains, info); -- // caml_leave_blocking_section(); -- -- if (retval < 0) { -- free(info); -- failwith_xc(_H(xch)); -- } -- for (i = 0; i < retval; i++) { -- result = caml_alloc_small(2, Tag_cons); -- Field(result, 0) = Val_int(0); -- Field(result, 1) = temp; -- temp = result; -- -- Store_field(result, 0, alloc_domaininfo(info + i)); -- } -- -- free(info); -- CAMLreturn(result); --} -- --CAMLprim value stub_xc_domain_getinfo(value xch, value domid) --{ -- CAMLparam2(xch, domid); -- CAMLlocal1(result); -- xc_domaininfo_t info; -- int ret; -- -- ret = xc_domain_getinfolist(_H(xch), _D(domid), 1, &info); -- if (ret != 1) -- failwith_xc(_H(xch)); -- if (info.domain != _D(domid)) -- failwith_xc(_H(xch)); -- -- result = alloc_domaininfo(&info); -- CAMLreturn(result); --} -- --CAMLprim value stub_xc_vcpu_getinfo(value xch, value domid, value vcpu) --{ -- CAMLparam3(xch, domid, vcpu); -- CAMLlocal1(result); -- xc_vcpuinfo_t info; -- int retval; -- -- uint32_t c_domid = _D(domid); -- uint32_t c_vcpu = Int_val(vcpu); -- // caml_enter_blocking_section(); -- retval = xc_vcpu_getinfo(_H(xch), c_domid, -- c_vcpu, &info); -- // caml_leave_blocking_section(); -- if (retval < 0) -- failwith_xc(_H(xch)); -- -- result = caml_alloc_tuple(5); -- Store_field(result, 0, Val_bool(info.online)); -- Store_field(result, 1, Val_bool(info.blocked)); -- Store_field(result, 2, Val_bool(info.running)); -- Store_field(result, 3, caml_copy_int64(info.cpu_time)); -- Store_field(result, 4, caml_copy_int32(info.cpu)); -- -- CAMLreturn(result); --} -- --CAMLprim value stub_xc_vcpu_context_get(value xch, value domid, -- value cpu) --{ -- CAMLparam3(xch, domid, cpu); -- CAMLlocal1(context); -- int ret; -- vcpu_guest_context_any_t ctxt; -- -- ret = xc_vcpu_getcontext(_H(xch), _D(domid), Int_val(cpu), &ctxt); -- -- context = caml_alloc_string(sizeof(ctxt)); -- memcpy(String_val(context), (char *) &ctxt.c, sizeof(ctxt.c)); -- -- CAMLreturn(context); --} -- --static int get_cpumap_len(value xch, value cpumap) --{ -- int ml_len = Wosize_val(cpumap); -- int xc_len = xc_get_max_cpus(_H(xch)); -- -- if (ml_len < xc_len) -- return ml_len; -- else -- return xc_len; --} -- --CAMLprim value stub_xc_vcpu_setaffinity(value xch, value domid, -- value vcpu, value cpumap) --{ -- CAMLparam4(xch, domid, vcpu, cpumap); -- int i, len = get_cpumap_len(xch, cpumap); -- xc_cpumap_t c_cpumap; -- int retval; -- -- c_cpumap = xc_cpumap_alloc(_H(xch)); -- if (c_cpumap == NULL) -- failwith_xc(_H(xch)); -- -- for (i=0; i> r) & 1) { -- tmp = caml_alloc_small(2, Tag_cons); -- Field(tmp, 0) = Val_int(r); -- Field(tmp, 1) = cap_list; -- cap_list = tmp; -- } -- } -- -- physinfo = caml_alloc_tuple(9); -- Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core)); -- Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket)); -- Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus)); -- Store_field(physinfo, 3, Val_int(c_physinfo.max_node_id)); -- Store_field(physinfo, 4, Val_int(c_physinfo.cpu_khz)); -- Store_field(physinfo, 5, caml_copy_nativeint(c_physinfo.total_pages)); -- Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages)); -- Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages)); -- Store_field(physinfo, 8, cap_list); -- -- CAMLreturn(physinfo); --} -- --CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus) --{ -- CAMLparam2(xch, nr_cpus); -- CAMLlocal2(pcpus, v); -- xc_cpuinfo_t *info; -- int r, size; -- -- if (Int_val(nr_cpus) < 1) -- caml_invalid_argument("nr_cpus"); -- -- info = calloc(Int_val(nr_cpus) + 1, sizeof(*info)); -- if (!info) -- caml_raise_out_of_memory(); -- -- // caml_enter_blocking_section(); -- r = xc_getcpuinfo(_H(xch), Int_val(nr_cpus), info, &size); -- // caml_leave_blocking_section(); -- -- if (r) { -- free(info); -- failwith_xc(_H(xch)); -- } -- -- if (size > 0) { -- int i; -- pcpus = caml_alloc(size, 0); -- for (i = 0; i < size; i++) { -- v = caml_copy_int64(info[i].idletime); -- caml_modify(&Field(pcpus, i), v); -- } -- } else -- pcpus = Atom(0); -- free(info); -- CAMLreturn(pcpus); --} -- --CAMLprim value stub_xc_domain_setmaxmem(value xch, value domid, -- value max_memkb) --{ -- CAMLparam3(xch, domid, max_memkb); -- -- uint32_t c_domid = _D(domid); -- unsigned int c_max_memkb = Int64_val(max_memkb); -- // caml_enter_blocking_section(); -- int retval = xc_domain_setmaxmem(_H(xch), c_domid, -- c_max_memkb); -- // caml_leave_blocking_section(); -- if (retval) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_set_memmap_limit(value xch, value domid, -- value map_limitkb) --{ -- CAMLparam3(xch, domid, map_limitkb); -- unsigned long v; -- int retval; -- -- v = Int64_val(map_limitkb); -- retval = xc_domain_set_memmap_limit(_H(xch), _D(domid), v); -- if (retval) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_memory_increase_reservation(value xch, -- value domid, -- value mem_kb) --{ -- CAMLparam3(xch, domid, mem_kb); -- -- unsigned long nr_extents = ((unsigned long)(Int64_val(mem_kb))) >> (PAGE_SHIFT - 10); -- -- uint32_t c_domid = _D(domid); -- // caml_enter_blocking_section(); -- int retval = xc_domain_increase_reservation_exact(_H(xch), c_domid, -- nr_extents, 0, 0, NULL); -- // caml_leave_blocking_section(); -- -- if (retval) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_set_machine_address_size(value xch, -- value domid, -- value width) --{ -- CAMLparam3(xch, domid, width); -- uint32_t c_domid = _D(domid); -- int c_width = Int_val(width); -- -- int retval = xc_domain_set_machine_address_size(_H(xch), c_domid, c_width); -- if (retval) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_get_machine_address_size(value xch, -- value domid) --{ -- CAMLparam2(xch, domid); -- int retval; -- -- retval = xc_domain_get_machine_address_size(_H(xch), _D(domid)); -- if (retval < 0) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_int(retval)); --} -- --CAMLprim value stub_xc_domain_cpuid_set(value xch, value domid, -- value input, -- value config) --{ -- CAMLparam4(xch, domid, input, config); -- CAMLlocal2(array, tmp); -- int r; -- unsigned int c_input[2]; -- char *c_config[4], *out_config[4]; -- -- c_config[0] = string_of_option_array(config, 0); -- c_config[1] = string_of_option_array(config, 1); -- c_config[2] = string_of_option_array(config, 2); -- c_config[3] = string_of_option_array(config, 3); -- -- cpuid_input_of_val(c_input[0], c_input[1], input); -- -- array = caml_alloc(4, 0); -- for (r = 0; r < 4; r++) { -- tmp = Val_none; -- if (c_config[r]) { -- tmp = caml_alloc_small(1, 0); -- Field(tmp, 0) = caml_alloc_string(32); -- } -- Store_field(array, r, tmp); -- } -- -- for (r = 0; r < 4; r++) -- out_config[r] = (c_config[r]) ? String_val(Field(Field(array, r), 0)) : NULL; -- -- r = xc_cpuid_set(_H(xch), _D(domid), -- c_input, (const char **)c_config, out_config); -- if (r < 0) -- failwith_xc(_H(xch)); -- CAMLreturn(array); --} -- --CAMLprim value stub_xc_domain_cpuid_apply_policy(value xch, value domid) --{ -- CAMLparam2(xch, domid); -- int r; -- -- r = xc_cpuid_apply_policy(_H(xch), _D(domid)); -- if (r < 0) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_cpuid_check(value xch, value input, value config) --{ -- CAMLparam3(xch, input, config); -- CAMLlocal3(ret, array, tmp); -- int r; -- unsigned int c_input[2]; -- char *c_config[4], *out_config[4]; -- -- c_config[0] = string_of_option_array(config, 0); -- c_config[1] = string_of_option_array(config, 1); -- c_config[2] = string_of_option_array(config, 2); -- c_config[3] = string_of_option_array(config, 3); -- -- cpuid_input_of_val(c_input[0], c_input[1], input); -- -- array = caml_alloc(4, 0); -- for (r = 0; r < 4; r++) { -- tmp = Val_none; -- if (c_config[r]) { -- tmp = caml_alloc_small(1, 0); -- Field(tmp, 0) = caml_alloc_string(32); -- } -- Store_field(array, r, tmp); -- } -- -- for (r = 0; r < 4; r++) -- out_config[r] = (c_config[r]) ? String_val(Field(Field(array, r), 0)) : NULL; -- -- r = xc_cpuid_check(_H(xch), c_input, (const char **)c_config, out_config); -- if (r < 0) -- failwith_xc(_H(xch)); -- -- ret = caml_alloc_tuple(2); -- Store_field(ret, 0, Val_bool(r)); -- Store_field(ret, 1, array); -- -- CAMLreturn(ret); --} -- --CAMLprim value stub_xc_version_version(value xch) --{ -- CAMLparam1(xch); -- CAMLlocal1(result); -- xen_extraversion_t extra; -- long packed; -- int retval; -- -- // caml_enter_blocking_section(); -- packed = xc_version(_H(xch), XENVER_version, NULL); -- retval = xc_version(_H(xch), XENVER_extraversion, &extra); -- // caml_leave_blocking_section(); -- -- if (retval) -- failwith_xc(_H(xch)); -- -- result = caml_alloc_tuple(3); -- -- Store_field(result, 0, Val_int(packed >> 16)); -- Store_field(result, 1, Val_int(packed & 0xffff)); -- Store_field(result, 2, caml_copy_string(extra)); -- -- CAMLreturn(result); --} -- -- --CAMLprim value stub_xc_version_compile_info(value xch) --{ -- CAMLparam1(xch); -- CAMLlocal1(result); -- xen_compile_info_t ci; -- int retval; -- -- // caml_enter_blocking_section(); -- retval = xc_version(_H(xch), XENVER_compile_info, &ci); -- // caml_leave_blocking_section(); -- -- if (retval) -- failwith_xc(_H(xch)); -- -- result = caml_alloc_tuple(4); -- -- Store_field(result, 0, caml_copy_string(ci.compiler)); -- Store_field(result, 1, caml_copy_string(ci.compile_by)); -- Store_field(result, 2, caml_copy_string(ci.compile_domain)); -- Store_field(result, 3, caml_copy_string(ci.compile_date)); -- -- CAMLreturn(result); --} -- -- --static value xc_version_single_string(value xch, int code, void *info) --{ -- CAMLparam1(xch); -- int retval; -- -- // caml_enter_blocking_section(); -- retval = xc_version(_H(xch), code, info); -- // caml_leave_blocking_section(); -- -- if (retval) -- failwith_xc(_H(xch)); -- -- CAMLreturn(caml_copy_string((char *)info)); --} -- -- --CAMLprim value stub_xc_version_changeset(value xch) --{ -- xen_changeset_info_t ci; -- -- return xc_version_single_string(xch, XENVER_changeset, &ci); --} -- -- --CAMLprim value stub_xc_version_capabilities(value xch) --{ -- xen_capabilities_info_t ci; -- -- return xc_version_single_string(xch, XENVER_capabilities, &ci); --} -- -- --CAMLprim value stub_pages_to_kib(value pages) --{ -- CAMLparam1(pages); -- -- CAMLreturn(caml_copy_int64(Int64_val(pages) << (PAGE_SHIFT - 10))); --} -- -- --CAMLprim value stub_map_foreign_range(value xch, value dom, -- value size, value mfn) --{ -- CAMLparam4(xch, dom, size, mfn); -- CAMLlocal1(result); -- struct mmap_interface *intf; -- uint32_t c_dom; -- unsigned long c_mfn; -- -- result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag); -- intf = (struct mmap_interface *) result; -- -- intf->len = Int_val(size); -- -- c_dom = _D(dom); -- c_mfn = Nativeint_val(mfn); -- // caml_enter_blocking_section(); -- intf->addr = xc_map_foreign_range(_H(xch), c_dom, -- intf->len, PROT_READ|PROT_WRITE, -- c_mfn); -- // caml_leave_blocking_section(); -- if (!intf->addr) -- caml_failwith("xc_map_foreign_range error"); -- CAMLreturn(result); --} -- --CAMLprim value stub_sched_credit_domain_get(value xch, value domid) --{ -- CAMLparam2(xch, domid); -- CAMLlocal1(sdom); -- struct xen_domctl_sched_credit c_sdom; -- int ret; -- -- // caml_enter_blocking_section(); -- ret = xc_sched_credit_domain_get(_H(xch), _D(domid), &c_sdom); -- // caml_leave_blocking_section(); -- if (ret != 0) -- failwith_xc(_H(xch)); -- -- sdom = caml_alloc_tuple(2); -- Store_field(sdom, 0, Val_int(c_sdom.weight)); -- Store_field(sdom, 1, Val_int(c_sdom.cap)); -- -- CAMLreturn(sdom); --} -- --CAMLprim value stub_sched_credit_domain_set(value xch, value domid, -- value sdom) --{ -- CAMLparam3(xch, domid, sdom); -- struct xen_domctl_sched_credit c_sdom; -- int ret; -- -- c_sdom.weight = Int_val(Field(sdom, 0)); -- c_sdom.cap = Int_val(Field(sdom, 1)); -- // caml_enter_blocking_section(); -- ret = xc_sched_credit_domain_set(_H(xch), _D(domid), &c_sdom); -- // caml_leave_blocking_section(); -- if (ret != 0) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_shadow_allocation_get(value xch, value domid) --{ -- CAMLparam2(xch, domid); -- CAMLlocal1(mb); -- unsigned long c_mb; -- int ret; -- -- // caml_enter_blocking_section(); -- ret = xc_shadow_control(_H(xch), _D(domid), -- XEN_DOMCTL_SHADOW_OP_GET_ALLOCATION, -- NULL, 0, &c_mb, 0, NULL); -- // caml_leave_blocking_section(); -- if (ret != 0) -- failwith_xc(_H(xch)); -- -- mb = Val_int(c_mb); -- CAMLreturn(mb); --} -- --CAMLprim value stub_shadow_allocation_set(value xch, value domid, -- value mb) --{ -- CAMLparam3(xch, domid, mb); -- unsigned long c_mb; -- int ret; -- -- c_mb = Int_val(mb); -- // caml_enter_blocking_section(); -- ret = xc_shadow_control(_H(xch), _D(domid), -- XEN_DOMCTL_SHADOW_OP_SET_ALLOCATION, -- NULL, 0, &c_mb, 0, NULL); -- // caml_leave_blocking_section(); -- if (ret != 0) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_get_pfn_list(value xch, value domid, -- value nr_pfns) --{ -- CAMLparam3(xch, domid, nr_pfns); -- CAMLlocal2(array, v); -- unsigned long c_nr_pfns; -- long ret, i; -- uint64_t *c_array; -- -- c_nr_pfns = Nativeint_val(nr_pfns); -- -- c_array = malloc(sizeof(uint64_t) * c_nr_pfns); -- if (!c_array) -- caml_raise_out_of_memory(); -- -- ret = xc_get_pfn_list(_H(xch), _D(domid), -- c_array, c_nr_pfns); -- if (ret < 0) { -- free(c_array); -- failwith_xc(_H(xch)); -- } -- -- array = caml_alloc(ret, 0); -- for (i = 0; i < ret; i++) { -- v = caml_copy_nativeint(c_array[i]); -- Store_field(array, i, v); -- } -- free(c_array); -- -- CAMLreturn(array); --} -- --CAMLprim value stub_xc_domain_ioport_permission(value xch, value domid, -- value start_port, value nr_ports, -- value allow) --{ -- CAMLparam5(xch, domid, start_port, nr_ports, allow); -- uint32_t c_start_port, c_nr_ports; -- uint8_t c_allow; -- int ret; -- -- c_start_port = Int_val(start_port); -- c_nr_ports = Int_val(nr_ports); -- c_allow = Bool_val(allow); -- -- ret = xc_domain_ioport_permission(_H(xch), _D(domid), -- c_start_port, c_nr_ports, c_allow); -- if (ret < 0) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_iomem_permission(value xch, value domid, -- value start_pfn, value nr_pfns, -- value allow) --{ -- CAMLparam5(xch, domid, start_pfn, nr_pfns, allow); -- unsigned long c_start_pfn, c_nr_pfns; -- uint8_t c_allow; -- int ret; -- -- c_start_pfn = Nativeint_val(start_pfn); -- c_nr_pfns = Nativeint_val(nr_pfns); -- c_allow = Bool_val(allow); -- -- ret = xc_domain_iomem_permission(_H(xch), _D(domid), -- c_start_pfn, c_nr_pfns, c_allow); -- if (ret < 0) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_irq_permission(value xch, value domid, -- value pirq, value allow) --{ -- CAMLparam4(xch, domid, pirq, allow); -- uint8_t c_pirq; -- uint8_t c_allow; -- int ret; -- -- c_pirq = Int_val(pirq); -- c_allow = Bool_val(allow); -- -- ret = xc_domain_irq_permission(_H(xch), _D(domid), -- c_pirq, c_allow); -- if (ret < 0) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_unit); --} -- --static uint32_t pci_dev_to_bdf(int domain, int bus, int slot, int func) --{ -- uint32_t bdf = 0; -- bdf |= (bus & 0xff) << 16; -- bdf |= (slot & 0x1f) << 11; -- bdf |= (func & 0x7) << 8; -- return bdf; --} -- --CAMLprim value stub_xc_domain_test_assign_device(value xch, value domid, value desc) --{ -- CAMLparam3(xch, domid, desc); -- int ret; -- int domain, bus, slot, func; -- uint32_t bdf; -- -- domain = Int_val(Field(desc, 0)); -- bus = Int_val(Field(desc, 1)); -- slot = Int_val(Field(desc, 2)); -- func = Int_val(Field(desc, 3)); -- bdf = pci_dev_to_bdf(domain, bus, slot, func); -- -- ret = xc_test_assign_device(_H(xch), _D(domid), bdf); -- -- CAMLreturn(Val_bool(ret == 0)); --} -- --CAMLprim value stub_xc_domain_assign_device(value xch, value domid, value desc) --{ -- CAMLparam3(xch, domid, desc); -- int ret; -- int domain, bus, slot, func; -- uint32_t bdf; -- -- domain = Int_val(Field(desc, 0)); -- bus = Int_val(Field(desc, 1)); -- slot = Int_val(Field(desc, 2)); -- func = Int_val(Field(desc, 3)); -- bdf = pci_dev_to_bdf(domain, bus, slot, func); -- -- ret = xc_assign_device(_H(xch), _D(domid), bdf); -- -- if (ret < 0) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_domain_deassign_device(value xch, value domid, value desc) --{ -- CAMLparam3(xch, domid, desc); -- int ret; -- int domain, bus, slot, func; -- uint32_t bdf; -- -- domain = Int_val(Field(desc, 0)); -- bus = Int_val(Field(desc, 1)); -- slot = Int_val(Field(desc, 2)); -- func = Int_val(Field(desc, 3)); -- bdf = pci_dev_to_bdf(domain, bus, slot, func); -- -- ret = xc_deassign_device(_H(xch), _D(domid), bdf); -- -- if (ret < 0) -- failwith_xc(_H(xch)); -- CAMLreturn(Val_unit); --} -- --CAMLprim value stub_xc_watchdog(value xch, value domid, value timeout) --{ -- CAMLparam3(xch, domid, timeout); -- int ret; -- unsigned int c_timeout = Int32_val(timeout); -- -- ret = xc_watchdog(_H(xch), _D(domid), c_timeout); -- if (ret < 0) -- failwith_xc(_H(xch)); -- -- CAMLreturn(Val_int(ret)); --} -- --/* -- * Local variables: -- * indent-tabs-mode: t -- * c-basic-offset: 8 -- * tab-width: 8 -- * End: -- */ ---- /dev/null -+++ b/tools/ocaml/libs/xc/xenctrl.ml -@@ -0,0 +1,326 @@ -+(* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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 domid = int -+ -+(* ** xenctrl.h ** *) -+ -+type vcpuinfo = -+{ -+ online: bool; -+ blocked: bool; -+ running: bool; -+ cputime: int64; -+ cpumap: int32; -+} -+ -+type domaininfo = -+{ -+ domid : domid; -+ dying : bool; -+ shutdown : bool; -+ paused : bool; -+ blocked : bool; -+ running : bool; -+ hvm_guest : bool; -+ shutdown_code : int; -+ total_memory_pages: nativeint; -+ max_memory_pages : nativeint; -+ shared_info_frame : int64; -+ cpu_time : int64; -+ nr_online_vcpus : int; -+ max_vcpu_id : int; -+ ssidref : int32; -+ handle : int array; -+} -+ -+type sched_control = -+{ -+ weight : int; -+ cap : int; -+} -+ -+type physinfo_cap_flag = -+ | CAP_HVM -+ | CAP_DirectIO -+ -+type physinfo = -+{ -+ threads_per_core : int; -+ cores_per_socket : int; -+ nr_cpus : int; -+ max_node_id : int; -+ cpu_khz : int; -+ total_pages : nativeint; -+ free_pages : nativeint; -+ scrub_pages : nativeint; -+ (* XXX hw_cap *) -+ capabilities : physinfo_cap_flag list; -+} -+ -+type version = -+{ -+ major : int; -+ minor : int; -+ extra : string; -+} -+ -+ -+type compile_info = -+{ -+ compiler : string; -+ compile_by : string; -+ compile_domain : string; -+ compile_date : string; -+} -+ -+type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt -+ -+type domain_create_flag = CDF_HVM | CDF_HAP -+ -+exception Error of string -+ -+type handle -+ -+(* this is only use by coredumping *) -+external sizeof_core_header: unit -> int -+ = "stub_sizeof_core_header" -+external sizeof_vcpu_guest_context: unit -> int -+ = "stub_sizeof_vcpu_guest_context" -+external sizeof_xen_pfn: unit -> int = "stub_sizeof_xen_pfn" -+(* end of use *) -+ -+external interface_open: unit -> handle = "stub_xc_interface_open" -+external interface_close: handle -> unit = "stub_xc_interface_close" -+ -+external is_fake: unit -> bool = "stub_xc_interface_is_fake" -+ -+let with_intf f = -+ let xc = interface_open () in -+ let r = try f xc with exn -> interface_close xc; raise exn in -+ interface_close xc; -+ r -+ -+external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid -+ = "stub_xc_domain_create" -+ -+let domain_create handle n flags uuid = -+ _domain_create handle n flags (Uuid.int_array_of_uuid uuid) -+ -+external _domain_sethandle: handle -> domid -> int array -> unit -+ = "stub_xc_domain_sethandle" -+ -+let domain_sethandle handle n uuid = -+ _domain_sethandle handle n (Uuid.int_array_of_uuid uuid) -+ -+external domain_max_vcpus: handle -> domid -> int -> unit -+ = "stub_xc_domain_max_vcpus" -+ -+external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause" -+external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause" -+external domain_resume_fast: handle -> domid -> unit = "stub_xc_domain_resume_fast" -+external domain_destroy: handle -> domid -> unit = "stub_xc_domain_destroy" -+ -+external domain_shutdown: handle -> domid -> shutdown_reason -> unit -+ = "stub_xc_domain_shutdown" -+ -+external _domain_getinfolist: handle -> domid -> int -> domaininfo list -+ = "stub_xc_domain_getinfolist" -+ -+let domain_getinfolist handle first_domain = -+ let nb = 2 in -+ let last_domid l = (List.hd l).domid + 1 in -+ let rec __getlist from = -+ let l = _domain_getinfolist handle from nb in -+ (if List.length l = nb then __getlist (last_domid l) else []) @ l -+ in -+ List.rev (__getlist first_domain) -+ -+external domain_getinfo: handle -> domid -> domaininfo= "stub_xc_domain_getinfo" -+ -+external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo -+ = "stub_xc_vcpu_getinfo" -+ -+external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit -+ = "stub_xc_domain_ioport_permission" -+external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit -+ = "stub_xc_domain_iomem_permission" -+external domain_irq_permission: handle -> domid -> int -> bool -> unit -+ = "stub_xc_domain_irq_permission" -+ -+external vcpu_affinity_set: handle -> domid -> int -> bool array -> unit -+ = "stub_xc_vcpu_setaffinity" -+external vcpu_affinity_get: handle -> domid -> int -> bool array -+ = "stub_xc_vcpu_getaffinity" -+ -+external vcpu_context_get: handle -> domid -> int -> string -+ = "stub_xc_vcpu_context_get" -+ -+external sched_id: handle -> int = "stub_xc_sched_id" -+ -+external sched_credit_domain_set: handle -> domid -> sched_control -> unit -+ = "stub_sched_credit_domain_set" -+external sched_credit_domain_get: handle -> domid -> sched_control -+ = "stub_sched_credit_domain_get" -+ -+external shadow_allocation_set: handle -> domid -> int -> unit -+ = "stub_shadow_allocation_set" -+external shadow_allocation_get: handle -> domid -> int -+ = "stub_shadow_allocation_get" -+ -+external evtchn_alloc_unbound: handle -> domid -> domid -> int -+ = "stub_xc_evtchn_alloc_unbound" -+external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset" -+ -+external readconsolering: handle -> string = "stub_xc_readconsolering" -+ -+external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys" -+external physinfo: handle -> physinfo = "stub_xc_physinfo" -+external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info" -+ -+external domain_setmaxmem: handle -> domid -> int64 -> unit -+ = "stub_xc_domain_setmaxmem" -+external domain_set_memmap_limit: handle -> domid -> int64 -> unit -+ = "stub_xc_domain_set_memmap_limit" -+external domain_memory_increase_reservation: handle -> domid -> int64 -> unit -+ = "stub_xc_domain_memory_increase_reservation" -+ -+external domain_set_machine_address_size: handle -> domid -> int -> unit -+ = "stub_xc_domain_set_machine_address_size" -+external domain_get_machine_address_size: handle -> domid -> int -+ = "stub_xc_domain_get_machine_address_size" -+ -+external domain_cpuid_set: handle -> domid -> (int64 * (int64 option)) -+ -> string option array -+ -> string option array -+ = "stub_xc_domain_cpuid_set" -+external domain_cpuid_apply_policy: handle -> domid -> unit -+ = "stub_xc_domain_cpuid_apply_policy" -+external cpuid_check: handle -> (int64 * (int64 option)) -> string option array -> (bool * string option array) -+ = "stub_xc_cpuid_check" -+ -+external map_foreign_range: handle -> domid -> int -+ -> nativeint -> Xenmmap.mmap_interface -+ = "stub_map_foreign_range" -+ -+external domain_get_pfn_list: handle -> domid -> nativeint -> nativeint array -+ = "stub_xc_domain_get_pfn_list" -+ -+external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit -+ = "stub_xc_domain_assign_device" -+external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit -+ = "stub_xc_domain_deassign_device" -+external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool -+ = "stub_xc_domain_test_assign_device" -+ -+external version: handle -> version = "stub_xc_version_version" -+external version_compile_info: handle -> compile_info -+ = "stub_xc_version_compile_info" -+external version_changeset: handle -> string = "stub_xc_version_changeset" -+external version_capabilities: handle -> string = -+ "stub_xc_version_capabilities" -+ -+external watchdog : handle -> int -> int32 -> int -+ = "stub_xc_watchdog" -+ -+(* core dump structure *) -+type core_magic = Magic_hvm | Magic_pv -+ -+type core_header = { -+ xch_magic: core_magic; -+ xch_nr_vcpus: int; -+ xch_nr_pages: nativeint; -+ xch_index_offset: int64; -+ xch_ctxt_offset: int64; -+ xch_pages_offset: int64; -+} -+ -+external marshall_core_header: core_header -> string = "stub_marshall_core_header" -+ -+(* coredump *) -+let coredump xch domid fd = -+ let dump s = -+ let wd = Unix.write fd s 0 (String.length s) in -+ if wd <> String.length s then -+ failwith "error while writing"; -+ in -+ -+ let info = domain_getinfo xch domid in -+ -+ let nrpages = info.total_memory_pages in -+ let ctxt = Array.make info.max_vcpu_id None in -+ let nr_vcpus = ref 0 in -+ for i = 0 to info.max_vcpu_id - 1 -+ do -+ ctxt.(i) <- try -+ let v = vcpu_context_get xch domid i in -+ incr nr_vcpus; -+ Some v -+ with _ -> None -+ done; -+ -+ (* FIXME page offset if not rounded to sup *) -+ let page_offset = -+ Int64.add -+ (Int64.of_int (sizeof_core_header () + -+ (sizeof_vcpu_guest_context () * !nr_vcpus))) -+ (Int64.of_nativeint ( -+ Nativeint.mul -+ (Nativeint.of_int (sizeof_xen_pfn ())) -+ nrpages) -+ ) -+ in -+ -+ let header = { -+ xch_magic = if info.hvm_guest then Magic_hvm else Magic_pv; -+ xch_nr_vcpus = !nr_vcpus; -+ xch_nr_pages = nrpages; -+ xch_ctxt_offset = Int64.of_int (sizeof_core_header ()); -+ xch_index_offset = Int64.of_int (sizeof_core_header () -+ + sizeof_vcpu_guest_context ()); -+ xch_pages_offset = page_offset; -+ } in -+ -+ dump (marshall_core_header header); -+ for i = 0 to info.max_vcpu_id - 1 -+ do -+ match ctxt.(i) with -+ | None -> () -+ | Some ctxt_i -> dump ctxt_i -+ done; -+ let pfns = domain_get_pfn_list xch domid nrpages in -+ if Array.length pfns <> Nativeint.to_int nrpages then -+ failwith "could not get the page frame list"; -+ -+ let page_size = Xenmmap.getpagesize () in -+ for i = 0 to Nativeint.to_int nrpages - 1 -+ do -+ let page = map_foreign_range xch domid page_size pfns.(i) in -+ let data = Xenmmap.read page 0 page_size in -+ Xenmmap.unmap page; -+ dump data -+ done -+ -+(* ** Misc ** *) -+ -+(** -+ Convert the given number of pages to an amount in KiB, rounded up. -+ *) -+external pages_to_kib : int64 -> int64 = "stub_pages_to_kib" -+let pages_to_mib pages = Int64.div (pages_to_kib pages) 1024L -+ -+let _ = Callback.register_exception "xc.error" (Error "register_callback") ---- /dev/null -+++ b/tools/ocaml/libs/xc/xenctrl.mli -@@ -0,0 +1,184 @@ -+(* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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 domid = int -+type vcpuinfo = { -+ online : bool; -+ blocked : bool; -+ running : bool; -+ cputime : int64; -+ cpumap : int32; -+} -+type domaininfo = { -+ domid : domid; -+ dying : bool; -+ shutdown : bool; -+ paused : bool; -+ blocked : bool; -+ running : bool; -+ hvm_guest : bool; -+ shutdown_code : int; -+ total_memory_pages : nativeint; -+ max_memory_pages : nativeint; -+ shared_info_frame : int64; -+ cpu_time : int64; -+ nr_online_vcpus : int; -+ max_vcpu_id : int; -+ ssidref : int32; -+ handle : int array; -+} -+type sched_control = { weight : int; cap : int; } -+type physinfo_cap_flag = CAP_HVM | CAP_DirectIO -+type physinfo = { -+ threads_per_core : int; -+ cores_per_socket : int; -+ nr_cpus : int; -+ max_node_id : int; -+ cpu_khz : int; -+ total_pages : nativeint; -+ free_pages : nativeint; -+ scrub_pages : nativeint; -+ capabilities : physinfo_cap_flag list; -+} -+type version = { major : int; minor : int; extra : string; } -+type compile_info = { -+ compiler : string; -+ compile_by : string; -+ compile_domain : string; -+ compile_date : string; -+} -+type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt -+ -+type domain_create_flag = CDF_HVM | CDF_HAP -+ -+exception Error of string -+type handle -+external sizeof_core_header : unit -> int = "stub_sizeof_core_header" -+external sizeof_vcpu_guest_context : unit -> int -+ = "stub_sizeof_vcpu_guest_context" -+external sizeof_xen_pfn : unit -> int = "stub_sizeof_xen_pfn" -+external interface_open : unit -> handle = "stub_xc_interface_open" -+external is_fake : unit -> bool = "stub_xc_interface_is_fake" -+external interface_close : handle -> unit = "stub_xc_interface_close" -+val with_intf : (handle -> 'a) -> 'a -+external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid -+ = "stub_xc_domain_create" -+val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t -> domid -+external _domain_sethandle : handle -> domid -> int array -> unit -+ = "stub_xc_domain_sethandle" -+val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit -+external domain_max_vcpus : handle -> domid -> int -> unit -+ = "stub_xc_domain_max_vcpus" -+external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause" -+external domain_unpause : handle -> domid -> unit = "stub_xc_domain_unpause" -+external domain_resume_fast : handle -> domid -> unit -+ = "stub_xc_domain_resume_fast" -+external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy" -+external domain_shutdown : handle -> domid -> shutdown_reason -> unit -+ = "stub_xc_domain_shutdown" -+external _domain_getinfolist : handle -> domid -> int -> domaininfo list -+ = "stub_xc_domain_getinfolist" -+val domain_getinfolist : handle -> domid -> domaininfo list -+external domain_getinfo : handle -> domid -> domaininfo -+ = "stub_xc_domain_getinfo" -+external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo -+ = "stub_xc_vcpu_getinfo" -+external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit -+ = "stub_xc_domain_ioport_permission" -+external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit -+ = "stub_xc_domain_iomem_permission" -+external domain_irq_permission: handle -> domid -> int -> bool -> unit -+ = "stub_xc_domain_irq_permission" -+external vcpu_affinity_set : handle -> domid -> int -> bool array -> unit -+ = "stub_xc_vcpu_setaffinity" -+external vcpu_affinity_get : handle -> domid -> int -> bool array -+ = "stub_xc_vcpu_getaffinity" -+external vcpu_context_get : handle -> domid -> int -> string -+ = "stub_xc_vcpu_context_get" -+external sched_id : handle -> int = "stub_xc_sched_id" -+external sched_credit_domain_set : handle -> domid -> sched_control -> unit -+ = "stub_sched_credit_domain_set" -+external sched_credit_domain_get : handle -> domid -> sched_control -+ = "stub_sched_credit_domain_get" -+external shadow_allocation_set : handle -> domid -> int -> unit -+ = "stub_shadow_allocation_set" -+external shadow_allocation_get : handle -> domid -> int -+ = "stub_shadow_allocation_get" -+external evtchn_alloc_unbound : handle -> domid -> domid -> int -+ = "stub_xc_evtchn_alloc_unbound" -+external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset" -+external readconsolering : handle -> string = "stub_xc_readconsolering" -+external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys" -+external physinfo : handle -> physinfo = "stub_xc_physinfo" -+external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info" -+external domain_setmaxmem : handle -> domid -> int64 -> unit -+ = "stub_xc_domain_setmaxmem" -+external domain_set_memmap_limit : handle -> domid -> int64 -> unit -+ = "stub_xc_domain_set_memmap_limit" -+external domain_memory_increase_reservation : -+ handle -> domid -> int64 -> unit -+ = "stub_xc_domain_memory_increase_reservation" -+external map_foreign_range : -+ handle -> domid -> int -> nativeint -> Xenmmap.mmap_interface -+ = "stub_map_foreign_range" -+external domain_get_pfn_list : -+ handle -> domid -> nativeint -> nativeint array -+ = "stub_xc_domain_get_pfn_list" -+ -+external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit -+ = "stub_xc_domain_assign_device" -+external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit -+ = "stub_xc_domain_deassign_device" -+external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool -+ = "stub_xc_domain_test_assign_device" -+ -+external version : handle -> version = "stub_xc_version_version" -+external version_compile_info : handle -> compile_info -+ = "stub_xc_version_compile_info" -+external version_changeset : handle -> string = "stub_xc_version_changeset" -+external version_capabilities : handle -> string -+ = "stub_xc_version_capabilities" -+type core_magic = Magic_hvm | Magic_pv -+type core_header = { -+ xch_magic : core_magic; -+ xch_nr_vcpus : int; -+ xch_nr_pages : nativeint; -+ xch_index_offset : int64; -+ xch_ctxt_offset : int64; -+ xch_pages_offset : int64; -+} -+external marshall_core_header : core_header -> string -+ = "stub_marshall_core_header" -+val coredump : handle -> domid -> Unix.file_descr -> unit -+external pages_to_kib : int64 -> int64 = "stub_pages_to_kib" -+val pages_to_mib : int64 -> int64 -+external watchdog : handle -> int -> int32 -> int -+ = "stub_xc_watchdog" -+ -+external domain_set_machine_address_size: handle -> domid -> int -> unit -+ = "stub_xc_domain_set_machine_address_size" -+external domain_get_machine_address_size: handle -> domid -> int -+ = "stub_xc_domain_get_machine_address_size" -+ -+external domain_cpuid_set: handle -> domid -> (int64 * (int64 option)) -+ -> string option array -+ -> string option array -+ = "stub_xc_domain_cpuid_set" -+external domain_cpuid_apply_policy: handle -> domid -> unit -+ = "stub_xc_domain_cpuid_apply_policy" -+external cpuid_check: handle -> (int64 * (int64 option)) -> string option array -> (bool * string option array) -+ = "stub_xc_cpuid_check" -+ ---- /dev/null -+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c -@@ -0,0 +1,1161 @@ -+/* -+ * Copyright (C) 2006-2007 XenSource Ltd. -+ * Copyright (C) 2008 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ */ -+ -+#define _XOPEN_SOURCE 600 -+#include -+#include -+ -+#define CAML_NAME_SPACE -+#include -+#include -+#include -+#include -+#include -+ -+#include -+#include -+#include -+ -+#include -+ -+#include "mmap_stubs.h" -+ -+#define PAGE_SHIFT 12 -+#define PAGE_SIZE (1UL << PAGE_SHIFT) -+#define PAGE_MASK (~(PAGE_SIZE-1)) -+ -+#define _H(__h) ((xc_interface *)(__h)) -+#define _D(__d) ((uint32_t)Int_val(__d)) -+ -+#define Val_none (Val_int(0)) -+ -+#define string_of_option_array(array, index) \ -+ ((Field(array, index) == Val_none) ? NULL : String_val(Field(Field(array, index), 0))) -+ -+/* maybe here we should check the range of the input instead of blindly -+ * casting it to uint32 */ -+#define cpuid_input_of_val(i1, i2, input) \ -+ i1 = (uint32_t) Int64_val(Field(input, 0)); \ -+ i2 = ((Field(input, 1) == Val_none) ? 0xffffffff : (uint32_t) Int64_val(Field(Field(input, 1), 0))); -+ -+#define ERROR_STRLEN 1024 -+void failwith_xc(xc_interface *xch) -+{ -+ static char error_str[ERROR_STRLEN]; -+ if (xch) { -+ const xc_error *error = xc_get_last_error(xch); -+ if (error->code == XC_ERROR_NONE) -+ snprintf(error_str, ERROR_STRLEN, "%d: %s", errno, strerror(errno)); -+ else -+ snprintf(error_str, ERROR_STRLEN, "%d: %s: %s", -+ error->code, -+ xc_error_code_to_desc(error->code), -+ error->message); -+ } else { -+ snprintf(error_str, ERROR_STRLEN, "Unable to open XC interface"); -+ } -+ caml_raise_with_string(*caml_named_value("xc.error"), error_str); -+} -+ -+CAMLprim value stub_sizeof_core_header(value unit) -+{ -+ CAMLparam1(unit); -+ CAMLreturn(Val_int(sizeof(struct xc_core_header))); -+} -+ -+CAMLprim value stub_sizeof_vcpu_guest_context(value unit) -+{ -+ CAMLparam1(unit); -+ CAMLreturn(Val_int(sizeof(struct vcpu_guest_context))); -+} -+ -+CAMLprim value stub_sizeof_xen_pfn(value unit) -+{ -+ CAMLparam1(unit); -+ CAMLreturn(Val_int(sizeof(xen_pfn_t))); -+} -+ -+#define XC_CORE_MAGIC 0xF00FEBED -+#define XC_CORE_MAGIC_HVM 0xF00FEBEE -+ -+CAMLprim value stub_marshall_core_header(value header) -+{ -+ CAMLparam1(header); -+ CAMLlocal1(s); -+ struct xc_core_header c_header; -+ -+ c_header.xch_magic = (Field(header, 0)) -+ ? XC_CORE_MAGIC -+ : XC_CORE_MAGIC_HVM; -+ c_header.xch_nr_vcpus = Int_val(Field(header, 1)); -+ c_header.xch_nr_pages = Nativeint_val(Field(header, 2)); -+ c_header.xch_ctxt_offset = Int64_val(Field(header, 3)); -+ c_header.xch_index_offset = Int64_val(Field(header, 4)); -+ c_header.xch_pages_offset = Int64_val(Field(header, 5)); -+ -+ s = caml_alloc_string(sizeof(c_header)); -+ memcpy(String_val(s), (char *) &c_header, sizeof(c_header)); -+ CAMLreturn(s); -+} -+ -+CAMLprim value stub_xc_interface_open(void) -+{ -+ CAMLparam0(); -+ xc_interface *xch; -+ xch = xc_interface_open(NULL, NULL, XC_OPENFLAG_NON_REENTRANT); -+ if (xch == NULL) -+ failwith_xc(NULL); -+ CAMLreturn((value)xch); -+} -+ -+ -+CAMLprim value stub_xc_interface_is_fake(void) -+{ -+ CAMLparam0(); -+ int is_fake = xc_interface_is_fake(); -+ CAMLreturn(Val_int(is_fake)); -+} -+ -+CAMLprim value stub_xc_interface_close(value xch) -+{ -+ CAMLparam1(xch); -+ -+ // caml_enter_blocking_section(); -+ xc_interface_close(_H(xch)); -+ // caml_leave_blocking_section(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+static int domain_create_flag_table[] = { -+ XEN_DOMCTL_CDF_hvm_guest, -+ XEN_DOMCTL_CDF_hap, -+}; -+ -+CAMLprim value stub_xc_domain_create(value xch, value ssidref, -+ value flags, value handle) -+{ -+ CAMLparam4(xch, ssidref, flags, handle); -+ -+ uint32_t domid = 0; -+ xen_domain_handle_t h = { 0 }; -+ int result; -+ int i; -+ uint32_t c_ssidref = Int32_val(ssidref); -+ unsigned int c_flags = 0; -+ value l; -+ -+ if (Wosize_val(handle) != 16) -+ caml_invalid_argument("Handle not a 16-integer array"); -+ -+ for (i = 0; i < sizeof(h); i++) { -+ h[i] = Int_val(Field(handle, i)) & 0xff; -+ } -+ -+ for (l = flags; l != Val_none; l = Field(l, 1)) { -+ int v = Int_val(Field(l, 0)); -+ c_flags |= domain_create_flag_table[v]; -+ } -+ -+ // caml_enter_blocking_section(); -+ result = xc_domain_create(_H(xch), c_ssidref, h, c_flags, &domid); -+ // caml_leave_blocking_section(); -+ -+ if (result < 0) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_int(domid)); -+} -+ -+CAMLprim value stub_xc_domain_max_vcpus(value xch, value domid, -+ value max_vcpus) -+{ -+ CAMLparam3(xch, domid, max_vcpus); -+ int r; -+ -+ r = xc_domain_max_vcpus(_H(xch), _D(domid), Int_val(max_vcpus)); -+ if (r) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+ -+value stub_xc_domain_sethandle(value xch, value domid, value handle) -+{ -+ CAMLparam3(xch, domid, handle); -+ xen_domain_handle_t h = { 0 }; -+ int i; -+ -+ if (Wosize_val(handle) != 16) -+ caml_invalid_argument("Handle not a 16-integer array"); -+ -+ for (i = 0; i < sizeof(h); i++) { -+ h[i] = Int_val(Field(handle, i)) & 0xff; -+ } -+ -+ i = xc_domain_sethandle(_H(xch), _D(domid), h); -+ if (i) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+static value dom_op(value xch, value domid, int (*fn)(xc_interface *, uint32_t)) -+{ -+ CAMLparam2(xch, domid); -+ -+ uint32_t c_domid = _D(domid); -+ -+ // caml_enter_blocking_section(); -+ int result = fn(_H(xch), c_domid); -+ // caml_leave_blocking_section(); -+ if (result) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_pause(value xch, value domid) -+{ -+ return dom_op(xch, domid, xc_domain_pause); -+} -+ -+ -+CAMLprim value stub_xc_domain_unpause(value xch, value domid) -+{ -+ return dom_op(xch, domid, xc_domain_unpause); -+} -+ -+CAMLprim value stub_xc_domain_destroy(value xch, value domid) -+{ -+ return dom_op(xch, domid, xc_domain_destroy); -+} -+ -+CAMLprim value stub_xc_domain_resume_fast(value xch, value domid) -+{ -+ CAMLparam2(xch, domid); -+ -+ uint32_t c_domid = _D(domid); -+ -+ // caml_enter_blocking_section(); -+ int result = xc_domain_resume(_H(xch), c_domid, 1); -+ // caml_leave_blocking_section(); -+ if (result) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_shutdown(value xch, value domid, value reason) -+{ -+ CAMLparam3(xch, domid, reason); -+ int ret; -+ -+ ret = xc_domain_shutdown(_H(xch), _D(domid), Int_val(reason)); -+ if (ret < 0) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+static value alloc_domaininfo(xc_domaininfo_t * info) -+{ -+ CAMLparam0(); -+ CAMLlocal2(result, tmp); -+ int i; -+ -+ result = caml_alloc_tuple(16); -+ -+ Store_field(result, 0, Val_int(info->domain)); -+ Store_field(result, 1, Val_bool(info->flags & XEN_DOMINF_dying)); -+ Store_field(result, 2, Val_bool(info->flags & XEN_DOMINF_shutdown)); -+ Store_field(result, 3, Val_bool(info->flags & XEN_DOMINF_paused)); -+ Store_field(result, 4, Val_bool(info->flags & XEN_DOMINF_blocked)); -+ Store_field(result, 5, Val_bool(info->flags & XEN_DOMINF_running)); -+ Store_field(result, 6, Val_bool(info->flags & XEN_DOMINF_hvm_guest)); -+ Store_field(result, 7, Val_int((info->flags >> XEN_DOMINF_shutdownshift) -+ & XEN_DOMINF_shutdownmask)); -+ Store_field(result, 8, caml_copy_nativeint(info->tot_pages)); -+ Store_field(result, 9, caml_copy_nativeint(info->max_pages)); -+ Store_field(result, 10, caml_copy_int64(info->shared_info_frame)); -+ Store_field(result, 11, caml_copy_int64(info->cpu_time)); -+ Store_field(result, 12, Val_int(info->nr_online_vcpus)); -+ Store_field(result, 13, Val_int(info->max_vcpu_id)); -+ Store_field(result, 14, caml_copy_int32(info->ssidref)); -+ -+ tmp = caml_alloc_small(16, 0); -+ for (i = 0; i < 16; i++) { -+ Field(tmp, i) = Val_int(info->handle[i]); -+ } -+ -+ Store_field(result, 15, tmp); -+ -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_xc_domain_getinfolist(value xch, value first_domain, value nb) -+{ -+ CAMLparam3(xch, first_domain, nb); -+ CAMLlocal2(result, temp); -+ xc_domaininfo_t * info; -+ int i, ret, toalloc, retval; -+ unsigned int c_max_domains; -+ uint32_t c_first_domain; -+ -+ /* get the minimum number of allocate byte we need and bump it up to page boundary */ -+ toalloc = (sizeof(xc_domaininfo_t) * Int_val(nb)) | 0xfff; -+ ret = posix_memalign((void **) ((void *) &info), 4096, toalloc); -+ if (ret) -+ caml_raise_out_of_memory(); -+ -+ result = temp = Val_emptylist; -+ -+ c_first_domain = _D(first_domain); -+ c_max_domains = Int_val(nb); -+ // caml_enter_blocking_section(); -+ retval = xc_domain_getinfolist(_H(xch), c_first_domain, -+ c_max_domains, info); -+ // caml_leave_blocking_section(); -+ -+ if (retval < 0) { -+ free(info); -+ failwith_xc(_H(xch)); -+ } -+ for (i = 0; i < retval; i++) { -+ result = caml_alloc_small(2, Tag_cons); -+ Field(result, 0) = Val_int(0); -+ Field(result, 1) = temp; -+ temp = result; -+ -+ Store_field(result, 0, alloc_domaininfo(info + i)); -+ } -+ -+ free(info); -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_xc_domain_getinfo(value xch, value domid) -+{ -+ CAMLparam2(xch, domid); -+ CAMLlocal1(result); -+ xc_domaininfo_t info; -+ int ret; -+ -+ ret = xc_domain_getinfolist(_H(xch), _D(domid), 1, &info); -+ if (ret != 1) -+ failwith_xc(_H(xch)); -+ if (info.domain != _D(domid)) -+ failwith_xc(_H(xch)); -+ -+ result = alloc_domaininfo(&info); -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_xc_vcpu_getinfo(value xch, value domid, value vcpu) -+{ -+ CAMLparam3(xch, domid, vcpu); -+ CAMLlocal1(result); -+ xc_vcpuinfo_t info; -+ int retval; -+ -+ uint32_t c_domid = _D(domid); -+ uint32_t c_vcpu = Int_val(vcpu); -+ // caml_enter_blocking_section(); -+ retval = xc_vcpu_getinfo(_H(xch), c_domid, -+ c_vcpu, &info); -+ // caml_leave_blocking_section(); -+ if (retval < 0) -+ failwith_xc(_H(xch)); -+ -+ result = caml_alloc_tuple(5); -+ Store_field(result, 0, Val_bool(info.online)); -+ Store_field(result, 1, Val_bool(info.blocked)); -+ Store_field(result, 2, Val_bool(info.running)); -+ Store_field(result, 3, caml_copy_int64(info.cpu_time)); -+ Store_field(result, 4, caml_copy_int32(info.cpu)); -+ -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_xc_vcpu_context_get(value xch, value domid, -+ value cpu) -+{ -+ CAMLparam3(xch, domid, cpu); -+ CAMLlocal1(context); -+ int ret; -+ vcpu_guest_context_any_t ctxt; -+ -+ ret = xc_vcpu_getcontext(_H(xch), _D(domid), Int_val(cpu), &ctxt); -+ -+ context = caml_alloc_string(sizeof(ctxt)); -+ memcpy(String_val(context), (char *) &ctxt.c, sizeof(ctxt.c)); -+ -+ CAMLreturn(context); -+} -+ -+static int get_cpumap_len(value xch, value cpumap) -+{ -+ int ml_len = Wosize_val(cpumap); -+ int xc_len = xc_get_max_cpus(_H(xch)); -+ -+ if (ml_len < xc_len) -+ return ml_len; -+ else -+ return xc_len; -+} -+ -+CAMLprim value stub_xc_vcpu_setaffinity(value xch, value domid, -+ value vcpu, value cpumap) -+{ -+ CAMLparam4(xch, domid, vcpu, cpumap); -+ int i, len = get_cpumap_len(xch, cpumap); -+ xc_cpumap_t c_cpumap; -+ int retval; -+ -+ c_cpumap = xc_cpumap_alloc(_H(xch)); -+ if (c_cpumap == NULL) -+ failwith_xc(_H(xch)); -+ -+ for (i=0; i> r) & 1) { -+ tmp = caml_alloc_small(2, Tag_cons); -+ Field(tmp, 0) = Val_int(r); -+ Field(tmp, 1) = cap_list; -+ cap_list = tmp; -+ } -+ } -+ -+ physinfo = caml_alloc_tuple(9); -+ Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core)); -+ Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket)); -+ Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus)); -+ Store_field(physinfo, 3, Val_int(c_physinfo.max_node_id)); -+ Store_field(physinfo, 4, Val_int(c_physinfo.cpu_khz)); -+ Store_field(physinfo, 5, caml_copy_nativeint(c_physinfo.total_pages)); -+ Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages)); -+ Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages)); -+ Store_field(physinfo, 8, cap_list); -+ -+ CAMLreturn(physinfo); -+} -+ -+CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus) -+{ -+ CAMLparam2(xch, nr_cpus); -+ CAMLlocal2(pcpus, v); -+ xc_cpuinfo_t *info; -+ int r, size; -+ -+ if (Int_val(nr_cpus) < 1) -+ caml_invalid_argument("nr_cpus"); -+ -+ info = calloc(Int_val(nr_cpus) + 1, sizeof(*info)); -+ if (!info) -+ caml_raise_out_of_memory(); -+ -+ // caml_enter_blocking_section(); -+ r = xc_getcpuinfo(_H(xch), Int_val(nr_cpus), info, &size); -+ // caml_leave_blocking_section(); -+ -+ if (r) { -+ free(info); -+ failwith_xc(_H(xch)); -+ } -+ -+ if (size > 0) { -+ int i; -+ pcpus = caml_alloc(size, 0); -+ for (i = 0; i < size; i++) { -+ v = caml_copy_int64(info[i].idletime); -+ caml_modify(&Field(pcpus, i), v); -+ } -+ } else -+ pcpus = Atom(0); -+ free(info); -+ CAMLreturn(pcpus); -+} -+ -+CAMLprim value stub_xc_domain_setmaxmem(value xch, value domid, -+ value max_memkb) -+{ -+ CAMLparam3(xch, domid, max_memkb); -+ -+ uint32_t c_domid = _D(domid); -+ unsigned int c_max_memkb = Int64_val(max_memkb); -+ // caml_enter_blocking_section(); -+ int retval = xc_domain_setmaxmem(_H(xch), c_domid, -+ c_max_memkb); -+ // caml_leave_blocking_section(); -+ if (retval) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_set_memmap_limit(value xch, value domid, -+ value map_limitkb) -+{ -+ CAMLparam3(xch, domid, map_limitkb); -+ unsigned long v; -+ int retval; -+ -+ v = Int64_val(map_limitkb); -+ retval = xc_domain_set_memmap_limit(_H(xch), _D(domid), v); -+ if (retval) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_memory_increase_reservation(value xch, -+ value domid, -+ value mem_kb) -+{ -+ CAMLparam3(xch, domid, mem_kb); -+ -+ unsigned long nr_extents = ((unsigned long)(Int64_val(mem_kb))) >> (PAGE_SHIFT - 10); -+ -+ uint32_t c_domid = _D(domid); -+ // caml_enter_blocking_section(); -+ int retval = xc_domain_increase_reservation_exact(_H(xch), c_domid, -+ nr_extents, 0, 0, NULL); -+ // caml_leave_blocking_section(); -+ -+ if (retval) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_set_machine_address_size(value xch, -+ value domid, -+ value width) -+{ -+ CAMLparam3(xch, domid, width); -+ uint32_t c_domid = _D(domid); -+ int c_width = Int_val(width); -+ -+ int retval = xc_domain_set_machine_address_size(_H(xch), c_domid, c_width); -+ if (retval) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_get_machine_address_size(value xch, -+ value domid) -+{ -+ CAMLparam2(xch, domid); -+ int retval; -+ -+ retval = xc_domain_get_machine_address_size(_H(xch), _D(domid)); -+ if (retval < 0) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_int(retval)); -+} -+ -+CAMLprim value stub_xc_domain_cpuid_set(value xch, value domid, -+ value input, -+ value config) -+{ -+ CAMLparam4(xch, domid, input, config); -+ CAMLlocal2(array, tmp); -+ int r; -+ unsigned int c_input[2]; -+ char *c_config[4], *out_config[4]; -+ -+ c_config[0] = string_of_option_array(config, 0); -+ c_config[1] = string_of_option_array(config, 1); -+ c_config[2] = string_of_option_array(config, 2); -+ c_config[3] = string_of_option_array(config, 3); -+ -+ cpuid_input_of_val(c_input[0], c_input[1], input); -+ -+ array = caml_alloc(4, 0); -+ for (r = 0; r < 4; r++) { -+ tmp = Val_none; -+ if (c_config[r]) { -+ tmp = caml_alloc_small(1, 0); -+ Field(tmp, 0) = caml_alloc_string(32); -+ } -+ Store_field(array, r, tmp); -+ } -+ -+ for (r = 0; r < 4; r++) -+ out_config[r] = (c_config[r]) ? String_val(Field(Field(array, r), 0)) : NULL; -+ -+ r = xc_cpuid_set(_H(xch), _D(domid), -+ c_input, (const char **)c_config, out_config); -+ if (r < 0) -+ failwith_xc(_H(xch)); -+ CAMLreturn(array); -+} -+ -+CAMLprim value stub_xc_domain_cpuid_apply_policy(value xch, value domid) -+{ -+ CAMLparam2(xch, domid); -+ int r; -+ -+ r = xc_cpuid_apply_policy(_H(xch), _D(domid)); -+ if (r < 0) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_cpuid_check(value xch, value input, value config) -+{ -+ CAMLparam3(xch, input, config); -+ CAMLlocal3(ret, array, tmp); -+ int r; -+ unsigned int c_input[2]; -+ char *c_config[4], *out_config[4]; -+ -+ c_config[0] = string_of_option_array(config, 0); -+ c_config[1] = string_of_option_array(config, 1); -+ c_config[2] = string_of_option_array(config, 2); -+ c_config[3] = string_of_option_array(config, 3); -+ -+ cpuid_input_of_val(c_input[0], c_input[1], input); -+ -+ array = caml_alloc(4, 0); -+ for (r = 0; r < 4; r++) { -+ tmp = Val_none; -+ if (c_config[r]) { -+ tmp = caml_alloc_small(1, 0); -+ Field(tmp, 0) = caml_alloc_string(32); -+ } -+ Store_field(array, r, tmp); -+ } -+ -+ for (r = 0; r < 4; r++) -+ out_config[r] = (c_config[r]) ? String_val(Field(Field(array, r), 0)) : NULL; -+ -+ r = xc_cpuid_check(_H(xch), c_input, (const char **)c_config, out_config); -+ if (r < 0) -+ failwith_xc(_H(xch)); -+ -+ ret = caml_alloc_tuple(2); -+ Store_field(ret, 0, Val_bool(r)); -+ Store_field(ret, 1, array); -+ -+ CAMLreturn(ret); -+} -+ -+CAMLprim value stub_xc_version_version(value xch) -+{ -+ CAMLparam1(xch); -+ CAMLlocal1(result); -+ xen_extraversion_t extra; -+ long packed; -+ int retval; -+ -+ // caml_enter_blocking_section(); -+ packed = xc_version(_H(xch), XENVER_version, NULL); -+ retval = xc_version(_H(xch), XENVER_extraversion, &extra); -+ // caml_leave_blocking_section(); -+ -+ if (retval) -+ failwith_xc(_H(xch)); -+ -+ result = caml_alloc_tuple(3); -+ -+ Store_field(result, 0, Val_int(packed >> 16)); -+ Store_field(result, 1, Val_int(packed & 0xffff)); -+ Store_field(result, 2, caml_copy_string(extra)); -+ -+ CAMLreturn(result); -+} -+ -+ -+CAMLprim value stub_xc_version_compile_info(value xch) -+{ -+ CAMLparam1(xch); -+ CAMLlocal1(result); -+ xen_compile_info_t ci; -+ int retval; -+ -+ // caml_enter_blocking_section(); -+ retval = xc_version(_H(xch), XENVER_compile_info, &ci); -+ // caml_leave_blocking_section(); -+ -+ if (retval) -+ failwith_xc(_H(xch)); -+ -+ result = caml_alloc_tuple(4); -+ -+ Store_field(result, 0, caml_copy_string(ci.compiler)); -+ Store_field(result, 1, caml_copy_string(ci.compile_by)); -+ Store_field(result, 2, caml_copy_string(ci.compile_domain)); -+ Store_field(result, 3, caml_copy_string(ci.compile_date)); -+ -+ CAMLreturn(result); -+} -+ -+ -+static value xc_version_single_string(value xch, int code, void *info) -+{ -+ CAMLparam1(xch); -+ int retval; -+ -+ // caml_enter_blocking_section(); -+ retval = xc_version(_H(xch), code, info); -+ // caml_leave_blocking_section(); -+ -+ if (retval) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(caml_copy_string((char *)info)); -+} -+ -+ -+CAMLprim value stub_xc_version_changeset(value xch) -+{ -+ xen_changeset_info_t ci; -+ -+ return xc_version_single_string(xch, XENVER_changeset, &ci); -+} -+ -+ -+CAMLprim value stub_xc_version_capabilities(value xch) -+{ -+ xen_capabilities_info_t ci; -+ -+ return xc_version_single_string(xch, XENVER_capabilities, &ci); -+} -+ -+ -+CAMLprim value stub_pages_to_kib(value pages) -+{ -+ CAMLparam1(pages); -+ -+ CAMLreturn(caml_copy_int64(Int64_val(pages) << (PAGE_SHIFT - 10))); -+} -+ -+ -+CAMLprim value stub_map_foreign_range(value xch, value dom, -+ value size, value mfn) -+{ -+ CAMLparam4(xch, dom, size, mfn); -+ CAMLlocal1(result); -+ struct mmap_interface *intf; -+ uint32_t c_dom; -+ unsigned long c_mfn; -+ -+ result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag); -+ intf = (struct mmap_interface *) result; -+ -+ intf->len = Int_val(size); -+ -+ c_dom = _D(dom); -+ c_mfn = Nativeint_val(mfn); -+ // caml_enter_blocking_section(); -+ intf->addr = xc_map_foreign_range(_H(xch), c_dom, -+ intf->len, PROT_READ|PROT_WRITE, -+ c_mfn); -+ // caml_leave_blocking_section(); -+ if (!intf->addr) -+ caml_failwith("xc_map_foreign_range error"); -+ CAMLreturn(result); -+} -+ -+CAMLprim value stub_sched_credit_domain_get(value xch, value domid) -+{ -+ CAMLparam2(xch, domid); -+ CAMLlocal1(sdom); -+ struct xen_domctl_sched_credit c_sdom; -+ int ret; -+ -+ // caml_enter_blocking_section(); -+ ret = xc_sched_credit_domain_get(_H(xch), _D(domid), &c_sdom); -+ // caml_leave_blocking_section(); -+ if (ret != 0) -+ failwith_xc(_H(xch)); -+ -+ sdom = caml_alloc_tuple(2); -+ Store_field(sdom, 0, Val_int(c_sdom.weight)); -+ Store_field(sdom, 1, Val_int(c_sdom.cap)); -+ -+ CAMLreturn(sdom); -+} -+ -+CAMLprim value stub_sched_credit_domain_set(value xch, value domid, -+ value sdom) -+{ -+ CAMLparam3(xch, domid, sdom); -+ struct xen_domctl_sched_credit c_sdom; -+ int ret; -+ -+ c_sdom.weight = Int_val(Field(sdom, 0)); -+ c_sdom.cap = Int_val(Field(sdom, 1)); -+ // caml_enter_blocking_section(); -+ ret = xc_sched_credit_domain_set(_H(xch), _D(domid), &c_sdom); -+ // caml_leave_blocking_section(); -+ if (ret != 0) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_shadow_allocation_get(value xch, value domid) -+{ -+ CAMLparam2(xch, domid); -+ CAMLlocal1(mb); -+ unsigned long c_mb; -+ int ret; -+ -+ // caml_enter_blocking_section(); -+ ret = xc_shadow_control(_H(xch), _D(domid), -+ XEN_DOMCTL_SHADOW_OP_GET_ALLOCATION, -+ NULL, 0, &c_mb, 0, NULL); -+ // caml_leave_blocking_section(); -+ if (ret != 0) -+ failwith_xc(_H(xch)); -+ -+ mb = Val_int(c_mb); -+ CAMLreturn(mb); -+} -+ -+CAMLprim value stub_shadow_allocation_set(value xch, value domid, -+ value mb) -+{ -+ CAMLparam3(xch, domid, mb); -+ unsigned long c_mb; -+ int ret; -+ -+ c_mb = Int_val(mb); -+ // caml_enter_blocking_section(); -+ ret = xc_shadow_control(_H(xch), _D(domid), -+ XEN_DOMCTL_SHADOW_OP_SET_ALLOCATION, -+ NULL, 0, &c_mb, 0, NULL); -+ // caml_leave_blocking_section(); -+ if (ret != 0) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_get_pfn_list(value xch, value domid, -+ value nr_pfns) -+{ -+ CAMLparam3(xch, domid, nr_pfns); -+ CAMLlocal2(array, v); -+ unsigned long c_nr_pfns; -+ long ret, i; -+ uint64_t *c_array; -+ -+ c_nr_pfns = Nativeint_val(nr_pfns); -+ -+ c_array = malloc(sizeof(uint64_t) * c_nr_pfns); -+ if (!c_array) -+ caml_raise_out_of_memory(); -+ -+ ret = xc_get_pfn_list(_H(xch), _D(domid), -+ c_array, c_nr_pfns); -+ if (ret < 0) { -+ free(c_array); -+ failwith_xc(_H(xch)); -+ } -+ -+ array = caml_alloc(ret, 0); -+ for (i = 0; i < ret; i++) { -+ v = caml_copy_nativeint(c_array[i]); -+ Store_field(array, i, v); -+ } -+ free(c_array); -+ -+ CAMLreturn(array); -+} -+ -+CAMLprim value stub_xc_domain_ioport_permission(value xch, value domid, -+ value start_port, value nr_ports, -+ value allow) -+{ -+ CAMLparam5(xch, domid, start_port, nr_ports, allow); -+ uint32_t c_start_port, c_nr_ports; -+ uint8_t c_allow; -+ int ret; -+ -+ c_start_port = Int_val(start_port); -+ c_nr_ports = Int_val(nr_ports); -+ c_allow = Bool_val(allow); -+ -+ ret = xc_domain_ioport_permission(_H(xch), _D(domid), -+ c_start_port, c_nr_ports, c_allow); -+ if (ret < 0) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_iomem_permission(value xch, value domid, -+ value start_pfn, value nr_pfns, -+ value allow) -+{ -+ CAMLparam5(xch, domid, start_pfn, nr_pfns, allow); -+ unsigned long c_start_pfn, c_nr_pfns; -+ uint8_t c_allow; -+ int ret; -+ -+ c_start_pfn = Nativeint_val(start_pfn); -+ c_nr_pfns = Nativeint_val(nr_pfns); -+ c_allow = Bool_val(allow); -+ -+ ret = xc_domain_iomem_permission(_H(xch), _D(domid), -+ c_start_pfn, c_nr_pfns, c_allow); -+ if (ret < 0) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_irq_permission(value xch, value domid, -+ value pirq, value allow) -+{ -+ CAMLparam4(xch, domid, pirq, allow); -+ uint8_t c_pirq; -+ uint8_t c_allow; -+ int ret; -+ -+ c_pirq = Int_val(pirq); -+ c_allow = Bool_val(allow); -+ -+ ret = xc_domain_irq_permission(_H(xch), _D(domid), -+ c_pirq, c_allow); -+ if (ret < 0) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_unit); -+} -+ -+static uint32_t pci_dev_to_bdf(int domain, int bus, int slot, int func) -+{ -+ uint32_t bdf = 0; -+ bdf |= (bus & 0xff) << 16; -+ bdf |= (slot & 0x1f) << 11; -+ bdf |= (func & 0x7) << 8; -+ return bdf; -+} -+ -+CAMLprim value stub_xc_domain_test_assign_device(value xch, value domid, value desc) -+{ -+ CAMLparam3(xch, domid, desc); -+ int ret; -+ int domain, bus, slot, func; -+ uint32_t bdf; -+ -+ domain = Int_val(Field(desc, 0)); -+ bus = Int_val(Field(desc, 1)); -+ slot = Int_val(Field(desc, 2)); -+ func = Int_val(Field(desc, 3)); -+ bdf = pci_dev_to_bdf(domain, bus, slot, func); -+ -+ ret = xc_test_assign_device(_H(xch), _D(domid), bdf); -+ -+ CAMLreturn(Val_bool(ret == 0)); -+} -+ -+CAMLprim value stub_xc_domain_assign_device(value xch, value domid, value desc) -+{ -+ CAMLparam3(xch, domid, desc); -+ int ret; -+ int domain, bus, slot, func; -+ uint32_t bdf; -+ -+ domain = Int_val(Field(desc, 0)); -+ bus = Int_val(Field(desc, 1)); -+ slot = Int_val(Field(desc, 2)); -+ func = Int_val(Field(desc, 3)); -+ bdf = pci_dev_to_bdf(domain, bus, slot, func); -+ -+ ret = xc_assign_device(_H(xch), _D(domid), bdf); -+ -+ if (ret < 0) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_domain_deassign_device(value xch, value domid, value desc) -+{ -+ CAMLparam3(xch, domid, desc); -+ int ret; -+ int domain, bus, slot, func; -+ uint32_t bdf; -+ -+ domain = Int_val(Field(desc, 0)); -+ bus = Int_val(Field(desc, 1)); -+ slot = Int_val(Field(desc, 2)); -+ func = Int_val(Field(desc, 3)); -+ bdf = pci_dev_to_bdf(domain, bus, slot, func); -+ -+ ret = xc_deassign_device(_H(xch), _D(domid), bdf); -+ -+ if (ret < 0) -+ failwith_xc(_H(xch)); -+ CAMLreturn(Val_unit); -+} -+ -+CAMLprim value stub_xc_watchdog(value xch, value domid, value timeout) -+{ -+ CAMLparam3(xch, domid, timeout); -+ int ret; -+ unsigned int c_timeout = Int32_val(timeout); -+ -+ ret = xc_watchdog(_H(xch), _D(domid), c_timeout); -+ if (ret < 0) -+ failwith_xc(_H(xch)); -+ -+ CAMLreturn(Val_int(ret)); -+} -+ -+/* -+ * Local variables: -+ * indent-tabs-mode: t -+ * c-basic-offset: 8 -+ * tab-width: 8 -+ * End: -+ */ ---- a/tools/ocaml/libs/xl/Makefile -+++ b/tools/ocaml/libs/xl/Makefile -@@ -2,14 +2,14 @@ - XEN_ROOT=$(TOPLEVEL)/../.. - include $(TOPLEVEL)/common.make - --OBJS = xl --INTF = xl.cmi --LIBS = xl.cma xl.cmxa -+OBJS = xenlight -+INTF = xenlight.cmi -+LIBS = xenlight.cma xenlight.cmxa - --xl_OBJS = $(OBJS) --xl_C_OBJS = xl_stubs -+xenlight_OBJS = $(OBJS) -+xenlight_C_OBJS = xenlight_stubs - --OCAML_LIBRARY = xl -+OCAML_LIBRARY = xenlight - - all: $(INTF) $(LIBS) - -@@ -18,11 +18,11 @@ - .PHONY: install - install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) -- ocamlfind remove -destdir $(OCAMLDESTDIR) xl -- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xl META $(INTF) $(LIBS) *.a *.so *.cmx -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight -+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenlight META $(INTF) $(LIBS) *.a *.so *.cmx - - .PHONY: uninstall - uninstall: -- ocamlfind remove -destdir $(OCAMLDESTDIR) xl -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight - - include $(TOPLEVEL)/Makefile.rules ---- /dev/null -+++ b/tools/ocaml/libs/xl/xenlight_stubs.c -@@ -0,0 +1,729 @@ -+/* -+ * Copyright (C) 2009-2010 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ */ -+ -+#include -+ -+#define CAML_NAME_SPACE -+#include -+#include -+#include -+#include -+#include -+ -+#include -+#include -+#include -+ -+#include "libxl.h" -+ -+struct caml_logger { -+ struct xentoollog_logger logger; -+ int log_offset; -+ char log_buf[2048]; -+}; -+ -+typedef struct caml_gc { -+ int offset; -+ void *ptrs[64]; -+} caml_gc; -+ -+void log_vmessage(struct xentoollog_logger *logger, xentoollog_level level, -+ int errnoval, const char *context, const char *format, va_list al) -+{ -+ struct caml_logger *ologger = (struct caml_logger *) logger; -+ -+ ologger->log_offset += vsnprintf(ologger->log_buf + ologger->log_offset, -+ 2048 - ologger->log_offset, format, al); -+} -+ -+void log_destroy(struct xentoollog_logger *logger) -+{ -+} -+ -+#define INIT_STRUCT() libxl_ctx ctx; struct caml_logger lg; struct caml_gc gc; gc.offset = 0; -+ -+#define INIT_CTX() \ -+ lg.logger.vmessage = log_vmessage; \ -+ lg.logger.destroy = log_destroy; \ -+ lg.logger.progress = NULL; \ -+ caml_enter_blocking_section(); \ -+ ret = libxl_ctx_init(&ctx, LIBXL_VERSION, (struct xentoollog_logger *) &lg); \ -+ if (ret != 0) \ -+ failwith_xl("cannot init context", &lg); -+ -+#define FREE_CTX() \ -+ gc_free(&gc); \ -+ caml_leave_blocking_section(); \ -+ libxl_ctx_free(&ctx) -+ -+static char * dup_String_val(caml_gc *gc, value s) -+{ -+ int len; -+ char *c; -+ len = caml_string_length(s); -+ c = calloc(len + 1, sizeof(char)); -+ if (!c) -+ caml_raise_out_of_memory(); -+ gc->ptrs[gc->offset++] = c; -+ memcpy(c, String_val(s), len); -+ return c; -+} -+ -+static void gc_free(caml_gc *gc) -+{ -+ int i; -+ for (i = 0; i < gc->offset; i++) { -+ free(gc->ptrs[i]); -+ } -+} -+ -+void failwith_xl(char *fname, struct caml_logger *lg) -+{ -+ char *s; -+ s = (lg) ? lg->log_buf : fname; -+ caml_raise_with_string(*caml_named_value("xl.error"), s); -+} -+ -+#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed then */ -+static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size) -+{ -+ void *ptr; -+ ptr = calloc(nmemb, size); -+ if (!ptr) -+ caml_raise_out_of_memory(); -+ gc->ptrs[gc->offset++] = ptr; -+ return ptr; -+} -+ -+static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value v) -+{ -+ CAMLparam1(v); -+ CAMLlocal1(a); -+ int i; -+ char **array; -+ -+ for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; } -+ -+ array = gc_calloc(gc, (i + 1) * 2, sizeof(char *)); -+ if (!array) -+ return 1; -+ for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) { -+ value b = Field(a, 0); -+ array[i * 2] = dup_String_val(gc, Field(b, 0)); -+ array[i * 2 + 1] = dup_String_val(gc, Field(b, 1)); -+ } -+ *c_val = array; -+ CAMLreturn(0); -+} -+ -+static int domain_create_info_val (caml_gc *gc, libxl_domain_create_info *c_val, value v) -+{ -+ CAMLparam1(v); -+ CAMLlocal1(a); -+ uint8_t *uuid = libxl_uuid_bytearray(&c_val->uuid); -+ int i; -+ -+ c_val->hvm = Bool_val(Field(v, 0)); -+ c_val->hap = Bool_val(Field(v, 1)); -+ c_val->oos = Bool_val(Field(v, 2)); -+ c_val->ssidref = Int32_val(Field(v, 3)); -+ c_val->name = dup_String_val(gc, Field(v, 4)); -+ a = Field(v, 5); -+ for (i = 0; i < 16; i++) -+ uuid[i] = Int_val(Field(a, i)); -+ string_string_tuple_array_val(gc, &(c_val->xsdata), Field(v, 6)); -+ string_string_tuple_array_val(gc, &(c_val->platformdata), Field(v, 7)); -+ -+ c_val->poolid = Int32_val(Field(v, 8)); -+ c_val->poolname = dup_String_val(gc, Field(v, 9)); -+ -+ CAMLreturn(0); -+} -+ -+static int domain_build_info_val (caml_gc *gc, libxl_domain_build_info *c_val, value v) -+{ -+ CAMLparam1(v); -+ CAMLlocal1(infopriv); -+ -+ c_val->max_vcpus = Int_val(Field(v, 0)); -+ c_val->cur_vcpus = Int_val(Field(v, 1)); -+ c_val->max_memkb = Int64_val(Field(v, 2)); -+ c_val->target_memkb = Int64_val(Field(v, 3)); -+ c_val->video_memkb = Int64_val(Field(v, 4)); -+ c_val->shadow_memkb = Int64_val(Field(v, 5)); -+ c_val->kernel.path = dup_String_val(gc, Field(v, 6)); -+ c_val->is_hvm = Tag_val(Field(v, 7)) == 0; -+ infopriv = Field(Field(v, 7), 0); -+ if (c_val->hvm) { -+ c_val->u.hvm.pae = Bool_val(Field(infopriv, 0)); -+ c_val->u.hvm.apic = Bool_val(Field(infopriv, 1)); -+ c_val->u.hvm.acpi = Bool_val(Field(infopriv, 2)); -+ c_val->u.hvm.nx = Bool_val(Field(infopriv, 3)); -+ c_val->u.hvm.viridian = Bool_val(Field(infopriv, 4)); -+ c_val->u.hvm.timeoffset = dup_String_val(gc, Field(infopriv, 5)); -+ c_val->u.hvm.timer_mode = Int_val(Field(infopriv, 6)); -+ c_val->u.hvm.hpet = Int_val(Field(infopriv, 7)); -+ c_val->u.hvm.vpt_align = Int_val(Field(infopriv, 8)); -+ } else { -+ c_val->u.pv.slack_memkb = Int64_val(Field(infopriv, 0)); -+ c_val->u.pv.cmdline = dup_String_val(gc, Field(infopriv, 1)); -+ c_val->u.pv.ramdisk.path = dup_String_val(gc, Field(infopriv, 2)); -+ c_val->u.pv.features = dup_String_val(gc, Field(infopriv, 3)); -+ } -+ -+ CAMLreturn(0); -+} -+#endif -+ -+static int device_disk_val(caml_gc *gc, libxl_device_disk *c_val, value v) -+{ -+ CAMLparam1(v); -+ -+ c_val->backend_domid = Int_val(Field(v, 0)); -+ c_val->pdev_path = dup_String_val(gc, Field(v, 1)); -+ c_val->vdev = dup_String_val(gc, Field(v, 2)); -+ c_val->backend = (Int_val(Field(v, 3))); -+ c_val->format = (Int_val(Field(v, 4))); -+ c_val->unpluggable = Bool_val(Field(v, 5)); -+ c_val->readwrite = Bool_val(Field(v, 6)); -+ c_val->is_cdrom = Bool_val(Field(v, 7)); -+ -+ CAMLreturn(0); -+} -+ -+static int device_nic_val(caml_gc *gc, libxl_device_nic *c_val, value v) -+{ -+ CAMLparam1(v); -+ int i; -+ int ret = 0; -+ c_val->backend_domid = Int_val(Field(v, 0)); -+ c_val->devid = Int_val(Field(v, 1)); -+ c_val->mtu = Int_val(Field(v, 2)); -+ c_val->model = dup_String_val(gc, Field(v, 3)); -+ -+ if (Wosize_val(Field(v, 4)) != 6) { -+ ret = 1; -+ goto out; -+ } -+ for (i = 0; i < 6; i++) -+ c_val->mac[i] = Int_val(Field(Field(v, 4), i)); -+ -+ /* not handling c_val->ip */ -+ c_val->bridge = dup_String_val(gc, Field(v, 5)); -+ c_val->ifname = dup_String_val(gc, Field(v, 6)); -+ c_val->script = dup_String_val(gc, Field(v, 7)); -+ c_val->nictype = (Int_val(Field(v, 8))) + NICTYPE_IOEMU; -+ -+out: -+ CAMLreturn(ret); -+} -+ -+static int device_console_val(caml_gc *gc, libxl_device_console *c_val, value v) -+{ -+ CAMLparam1(v); -+ -+ c_val->backend_domid = Int_val(Field(v, 0)); -+ c_val->devid = Int_val(Field(v, 1)); -+ c_val->consback = (Int_val(Field(v, 2))) + LIBXL_CONSBACK_XENCONSOLED; -+ -+ CAMLreturn(0); -+} -+ -+static int device_vkb_val(caml_gc *gc, libxl_device_vkb *c_val, value v) -+{ -+ CAMLparam1(v); -+ -+ c_val->backend_domid = Int_val(Field(v, 0)); -+ c_val->devid = Int_val(Field(v, 1)); -+ -+ CAMLreturn(0); -+} -+ -+static int device_vfb_val(caml_gc *gc, libxl_device_vfb *c_val, value v) -+{ -+ CAMLparam1(v); -+ -+ c_val->backend_domid = Int_val(Field(v, 0)); -+ c_val->devid = Int_val(Field(v, 1)); -+ c_val->vnc = Bool_val(Field(v, 2)); -+ c_val->vnclisten = dup_String_val(gc, Field(v, 3)); -+ c_val->vncpasswd = dup_String_val(gc, Field(v, 4)); -+ c_val->vncdisplay = Int_val(Field(v, 5)); -+ c_val->keymap = dup_String_val(gc, Field(v, 6)); -+ c_val->sdl = Bool_val(Field(v, 7)); -+ c_val->opengl = Bool_val(Field(v, 8)); -+ c_val->display = dup_String_val(gc, Field(v, 9)); -+ c_val->xauthority = dup_String_val(gc, Field(v, 10)); -+ -+ CAMLreturn(0); -+} -+ -+static int device_pci_val(caml_gc *gc, libxl_device_pci *c_val, value v) -+{ -+ union { -+ unsigned int value; -+ struct { -+ unsigned int reserved1:2; -+ unsigned int reg:6; -+ unsigned int func:3; -+ unsigned int dev:5; -+ unsigned int bus:8; -+ unsigned int reserved2:7; -+ unsigned int enable:1; -+ }fields; -+ }u; -+ CAMLparam1(v); -+ -+ /* FIXME: propagate API change to ocaml */ -+ u.value = Int_val(Field(v, 0)); -+ c_val->reg = u.fields.reg; -+ c_val->func = u.fields.func; -+ c_val->dev = u.fields.dev; -+ c_val->bus = u.fields.bus; -+ c_val->enable = u.fields.enable; -+ -+ c_val->domain = Int_val(Field(v, 1)); -+ c_val->vdevfn = Int_val(Field(v, 2)); -+ c_val->msitranslate = Bool_val(Field(v, 3)); -+ c_val->power_mgmt = Bool_val(Field(v, 4)); -+ -+ CAMLreturn(0); -+} -+ -+static int sched_credit_val(caml_gc *gc, libxl_sched_credit *c_val, value v) -+{ -+ CAMLparam1(v); -+ c_val->weight = Int_val(Field(v, 0)); -+ c_val->cap = Int_val(Field(v, 1)); -+ CAMLreturn(0); -+} -+ -+static int domain_build_state_val(caml_gc *gc, libxl_domain_build_state *c_val, value v) -+{ -+ CAMLparam1(v); -+ -+ c_val->store_port = Int_val(Field(v, 0)); -+ c_val->store_mfn = Int64_val(Field(v, 1)); -+ c_val->console_port = Int_val(Field(v, 2)); -+ c_val->console_mfn = Int64_val(Field(v, 3)); -+ -+ CAMLreturn(0); -+} -+ -+static value Val_sched_credit(libxl_sched_credit *c_val) -+{ -+ CAMLparam0(); -+ CAMLlocal1(v); -+ -+ v = caml_alloc_tuple(2); -+ -+ Store_field(v, 0, Val_int(c_val->weight)); -+ Store_field(v, 1, Val_int(c_val->cap)); -+ -+ CAMLreturn(v); -+} -+ -+static value Val_physinfo(libxl_physinfo *c_val) -+{ -+ CAMLparam0(); -+ CAMLlocal2(v, hwcap); -+ int i; -+ -+ hwcap = caml_alloc_tuple(8); -+ for (i = 0; i < 8; i++) -+ Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i])); -+ -+ v = caml_alloc_tuple(11); -+ Store_field(v, 0, Val_int(c_val->threads_per_core)); -+ Store_field(v, 1, Val_int(c_val->cores_per_socket)); -+ Store_field(v, 2, Val_int(c_val->max_cpu_id)); -+ Store_field(v, 3, Val_int(c_val->nr_cpus)); -+ Store_field(v, 4, Val_int(c_val->cpu_khz)); -+ Store_field(v, 5, caml_copy_int64(c_val->total_pages)); -+ Store_field(v, 6, caml_copy_int64(c_val->free_pages)); -+ Store_field(v, 7, caml_copy_int64(c_val->scrub_pages)); -+ Store_field(v, 8, Val_int(c_val->nr_nodes)); -+ Store_field(v, 9, hwcap); -+ Store_field(v, 10, caml_copy_int32(c_val->phys_cap)); -+ -+ CAMLreturn(v); -+} -+ -+value stub_xl_disk_add(value info, value domid) -+{ -+ CAMLparam2(info, domid); -+ libxl_device_disk c_info; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_disk_val(&gc, &c_info, info); -+ c_info.domid = Int_val(domid); -+ -+ INIT_CTX(); -+ ret = libxl_device_disk_add(&ctx, Int_val(domid), &c_info); -+ if (ret != 0) -+ failwith_xl("disk_add", &lg); -+ FREE_CTX(); -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_disk_remove(value info, value domid) -+{ -+ CAMLparam2(info, domid); -+ libxl_device_disk c_info; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_disk_val(&gc, &c_info, info); -+ c_info.domid = Int_val(domid); -+ -+ INIT_CTX(); -+ ret = libxl_device_disk_del(&ctx, &c_info, 0); -+ if (ret != 0) -+ failwith_xl("disk_remove", &lg); -+ FREE_CTX(); -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_nic_add(value info, value domid) -+{ -+ CAMLparam2(info, domid); -+ libxl_device_nic c_info; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_nic_val(&gc, &c_info, info); -+ c_info.domid = Int_val(domid); -+ -+ INIT_CTX(); -+ ret = libxl_device_nic_add(&ctx, Int_val(domid), &c_info); -+ if (ret != 0) -+ failwith_xl("nic_add", &lg); -+ FREE_CTX(); -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_nic_remove(value info, value domid) -+{ -+ CAMLparam2(info, domid); -+ libxl_device_nic c_info; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_nic_val(&gc, &c_info, info); -+ c_info.domid = Int_val(domid); -+ -+ INIT_CTX(); -+ ret = libxl_device_nic_del(&ctx, &c_info, 0); -+ if (ret != 0) -+ failwith_xl("nic_remove", &lg); -+ FREE_CTX(); -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_console_add(value info, value state, value domid) -+{ -+ CAMLparam3(info, state, domid); -+ libxl_device_console c_info; -+ libxl_domain_build_state c_state; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_console_val(&gc, &c_info, info); -+ domain_build_state_val(&gc, &c_state, state); -+ c_info.domid = Int_val(domid); -+ c_info.build_state = &c_state; -+ -+ INIT_CTX(); -+ ret = libxl_device_console_add(&ctx, Int_val(domid), &c_info); -+ if (ret != 0) -+ failwith_xl("console_add", &lg); -+ FREE_CTX(); -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_vkb_add(value info, value domid) -+{ -+ CAMLparam2(info, domid); -+ libxl_device_vkb c_info; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_vkb_val(&gc, &c_info, info); -+ c_info.domid = Int_val(domid); -+ -+ INIT_CTX(); -+ ret = libxl_device_vkb_add(&ctx, Int_val(domid), &c_info); -+ if (ret != 0) -+ failwith_xl("vkb_add", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_vkb_clean_shutdown(value domid) -+{ -+ CAMLparam1(domid); -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_device_vkb_clean_shutdown(&ctx, Int_val(domid)); -+ if (ret != 0) -+ failwith_xl("vkb_clean_shutdown", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_vkb_hard_shutdown(value domid) -+{ -+ CAMLparam1(domid); -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_device_vkb_hard_shutdown(&ctx, Int_val(domid)); -+ if (ret != 0) -+ failwith_xl("vkb_hard_shutdown", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_vfb_add(value info, value domid) -+{ -+ CAMLparam2(info, domid); -+ libxl_device_vfb c_info; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_vfb_val(&gc, &c_info, info); -+ c_info.domid = Int_val(domid); -+ -+ INIT_CTX(); -+ ret = libxl_device_vfb_add(&ctx, Int_val(domid), &c_info); -+ if (ret != 0) -+ failwith_xl("vfb_add", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_vfb_clean_shutdown(value domid) -+{ -+ CAMLparam1(domid); -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_device_vfb_clean_shutdown(&ctx, Int_val(domid)); -+ if (ret != 0) -+ failwith_xl("vfb_clean_shutdown", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_vfb_hard_shutdown(value domid) -+{ -+ CAMLparam1(domid); -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_device_vfb_hard_shutdown(&ctx, Int_val(domid)); -+ if (ret != 0) -+ failwith_xl("vfb_hard_shutdown", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_pci_add(value info, value domid) -+{ -+ CAMLparam2(info, domid); -+ libxl_device_pci c_info; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_pci_val(&gc, &c_info, info); -+ -+ INIT_CTX(); -+ ret = libxl_device_pci_add(&ctx, Int_val(domid), &c_info); -+ if (ret != 0) -+ failwith_xl("pci_add", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_pci_remove(value info, value domid) -+{ -+ CAMLparam2(info, domid); -+ libxl_device_pci c_info; -+ int ret; -+ INIT_STRUCT(); -+ -+ device_pci_val(&gc, &c_info, info); -+ -+ INIT_CTX(); -+ ret = libxl_device_pci_remove(&ctx, Int_val(domid), &c_info, 0); -+ if (ret != 0) -+ failwith_xl("pci_remove", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_pci_shutdown(value domid) -+{ -+ CAMLparam1(domid); -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_device_pci_shutdown(&ctx, Int_val(domid)); -+ if (ret != 0) -+ failwith_xl("pci_shutdown", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_button_press(value domid, value button) -+{ -+ CAMLparam2(domid, button); -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_button_press(&ctx, Int_val(domid), Int_val(button) + POWER_BUTTON); -+ if (ret != 0) -+ failwith_xl("button_press", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_physinfo(value unit) -+{ -+ CAMLparam1(unit); -+ CAMLlocal1(physinfo); -+ libxl_physinfo c_physinfo; -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_get_physinfo(&ctx, &c_physinfo); -+ if (ret != 0) -+ failwith_xl("physinfo", &lg); -+ FREE_CTX(); -+ -+ physinfo = Val_physinfo(&c_physinfo); -+ CAMLreturn(physinfo); -+} -+ -+value stub_xl_sched_credit_domain_get(value domid) -+{ -+ CAMLparam1(domid); -+ CAMLlocal1(scinfo); -+ libxl_sched_credit c_scinfo; -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_sched_credit_domain_get(&ctx, Int_val(domid), &c_scinfo); -+ if (ret != 0) -+ failwith_xl("sched_credit_domain_get", &lg); -+ FREE_CTX(); -+ -+ scinfo = Val_sched_credit(&c_scinfo); -+ CAMLreturn(scinfo); -+} -+ -+value stub_xl_sched_credit_domain_set(value domid, value scinfo) -+{ -+ CAMLparam2(domid, scinfo); -+ libxl_sched_credit c_scinfo; -+ int ret; -+ INIT_STRUCT(); -+ -+ sched_credit_val(&gc, &c_scinfo, scinfo); -+ -+ INIT_CTX(); -+ ret = libxl_sched_credit_domain_set(&ctx, Int_val(domid), &c_scinfo); -+ if (ret != 0) -+ failwith_xl("sched_credit_domain_set", &lg); -+ FREE_CTX(); -+ -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_send_trigger(value domid, value trigger, value vcpuid) -+{ -+ CAMLparam3(domid, trigger, vcpuid); -+ int ret; -+ char *c_trigger; -+ INIT_STRUCT(); -+ -+ c_trigger = dup_String_val(&gc, trigger); -+ -+ INIT_CTX(); -+ ret = libxl_send_trigger(&ctx, Int_val(domid), c_trigger, Int_val(vcpuid)); -+ if (ret != 0) -+ failwith_xl("send_trigger", &lg); -+ FREE_CTX(); -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_send_sysrq(value domid, value sysrq) -+{ -+ CAMLparam2(domid, sysrq); -+ int ret; -+ INIT_STRUCT(); -+ -+ INIT_CTX(); -+ ret = libxl_send_sysrq(&ctx, Int_val(domid), Int_val(sysrq)); -+ if (ret != 0) -+ failwith_xl("send_sysrq", &lg); -+ FREE_CTX(); -+ CAMLreturn(Val_unit); -+} -+ -+value stub_xl_send_debug_keys(value keys) -+{ -+ CAMLparam1(keys); -+ int ret; -+ char *c_keys; -+ INIT_STRUCT(); -+ -+ c_keys = dup_String_val(&gc, keys); -+ -+ INIT_CTX(); -+ ret = libxl_send_debug_keys(&ctx, c_keys); -+ if (ret != 0) -+ failwith_xl("send_debug_keys", &lg); -+ FREE_CTX(); -+ CAMLreturn(Val_unit); -+} -+ -+/* -+ * Local variables: -+ * indent-tabs-mode: t -+ * c-basic-offset: 8 -+ * tab-width: 8 -+ * End: -+ */ ---- a/tools/ocaml/libs/xl/xl_stubs.c -+++ /dev/null -@@ -1,729 +0,0 @@ --/* -- * Copyright (C) 2009-2010 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- */ -- --#include -- --#define CAML_NAME_SPACE --#include --#include --#include --#include --#include -- --#include --#include --#include -- --#include "libxl.h" -- --struct caml_logger { -- struct xentoollog_logger logger; -- int log_offset; -- char log_buf[2048]; --}; -- --typedef struct caml_gc { -- int offset; -- void *ptrs[64]; --} caml_gc; -- --void log_vmessage(struct xentoollog_logger *logger, xentoollog_level level, -- int errnoval, const char *context, const char *format, va_list al) --{ -- struct caml_logger *ologger = (struct caml_logger *) logger; -- -- ologger->log_offset += vsnprintf(ologger->log_buf + ologger->log_offset, -- 2048 - ologger->log_offset, format, al); --} -- --void log_destroy(struct xentoollog_logger *logger) --{ --} -- --#define INIT_STRUCT() libxl_ctx ctx; struct caml_logger lg; struct caml_gc gc; gc.offset = 0; -- --#define INIT_CTX() \ -- lg.logger.vmessage = log_vmessage; \ -- lg.logger.destroy = log_destroy; \ -- lg.logger.progress = NULL; \ -- caml_enter_blocking_section(); \ -- ret = libxl_ctx_init(&ctx, LIBXL_VERSION, (struct xentoollog_logger *) &lg); \ -- if (ret != 0) \ -- failwith_xl("cannot init context", &lg); -- --#define FREE_CTX() \ -- gc_free(&gc); \ -- caml_leave_blocking_section(); \ -- libxl_ctx_free(&ctx) -- --static char * dup_String_val(caml_gc *gc, value s) --{ -- int len; -- char *c; -- len = caml_string_length(s); -- c = calloc(len + 1, sizeof(char)); -- if (!c) -- caml_raise_out_of_memory(); -- gc->ptrs[gc->offset++] = c; -- memcpy(c, String_val(s), len); -- return c; --} -- --static void gc_free(caml_gc *gc) --{ -- int i; -- for (i = 0; i < gc->offset; i++) { -- free(gc->ptrs[i]); -- } --} -- --void failwith_xl(char *fname, struct caml_logger *lg) --{ -- char *s; -- s = (lg) ? lg->log_buf : fname; -- caml_raise_with_string(*caml_named_value("xl.error"), s); --} -- --#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed then */ --static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size) --{ -- void *ptr; -- ptr = calloc(nmemb, size); -- if (!ptr) -- caml_raise_out_of_memory(); -- gc->ptrs[gc->offset++] = ptr; -- return ptr; --} -- --static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value v) --{ -- CAMLparam1(v); -- CAMLlocal1(a); -- int i; -- char **array; -- -- for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; } -- -- array = gc_calloc(gc, (i + 1) * 2, sizeof(char *)); -- if (!array) -- return 1; -- for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) { -- value b = Field(a, 0); -- array[i * 2] = dup_String_val(gc, Field(b, 0)); -- array[i * 2 + 1] = dup_String_val(gc, Field(b, 1)); -- } -- *c_val = array; -- CAMLreturn(0); --} -- --static int domain_create_info_val (caml_gc *gc, libxl_domain_create_info *c_val, value v) --{ -- CAMLparam1(v); -- CAMLlocal1(a); -- uint8_t *uuid = libxl_uuid_bytearray(&c_val->uuid); -- int i; -- -- c_val->hvm = Bool_val(Field(v, 0)); -- c_val->hap = Bool_val(Field(v, 1)); -- c_val->oos = Bool_val(Field(v, 2)); -- c_val->ssidref = Int32_val(Field(v, 3)); -- c_val->name = dup_String_val(gc, Field(v, 4)); -- a = Field(v, 5); -- for (i = 0; i < 16; i++) -- uuid[i] = Int_val(Field(a, i)); -- string_string_tuple_array_val(gc, &(c_val->xsdata), Field(v, 6)); -- string_string_tuple_array_val(gc, &(c_val->platformdata), Field(v, 7)); -- -- c_val->poolid = Int32_val(Field(v, 8)); -- c_val->poolname = dup_String_val(gc, Field(v, 9)); -- -- CAMLreturn(0); --} -- --static int domain_build_info_val (caml_gc *gc, libxl_domain_build_info *c_val, value v) --{ -- CAMLparam1(v); -- CAMLlocal1(infopriv); -- -- c_val->max_vcpus = Int_val(Field(v, 0)); -- c_val->cur_vcpus = Int_val(Field(v, 1)); -- c_val->max_memkb = Int64_val(Field(v, 2)); -- c_val->target_memkb = Int64_val(Field(v, 3)); -- c_val->video_memkb = Int64_val(Field(v, 4)); -- c_val->shadow_memkb = Int64_val(Field(v, 5)); -- c_val->kernel.path = dup_String_val(gc, Field(v, 6)); -- c_val->is_hvm = Tag_val(Field(v, 7)) == 0; -- infopriv = Field(Field(v, 7), 0); -- if (c_val->hvm) { -- c_val->u.hvm.pae = Bool_val(Field(infopriv, 0)); -- c_val->u.hvm.apic = Bool_val(Field(infopriv, 1)); -- c_val->u.hvm.acpi = Bool_val(Field(infopriv, 2)); -- c_val->u.hvm.nx = Bool_val(Field(infopriv, 3)); -- c_val->u.hvm.viridian = Bool_val(Field(infopriv, 4)); -- c_val->u.hvm.timeoffset = dup_String_val(gc, Field(infopriv, 5)); -- c_val->u.hvm.timer_mode = Int_val(Field(infopriv, 6)); -- c_val->u.hvm.hpet = Int_val(Field(infopriv, 7)); -- c_val->u.hvm.vpt_align = Int_val(Field(infopriv, 8)); -- } else { -- c_val->u.pv.slack_memkb = Int64_val(Field(infopriv, 0)); -- c_val->u.pv.cmdline = dup_String_val(gc, Field(infopriv, 1)); -- c_val->u.pv.ramdisk.path = dup_String_val(gc, Field(infopriv, 2)); -- c_val->u.pv.features = dup_String_val(gc, Field(infopriv, 3)); -- } -- -- CAMLreturn(0); --} --#endif -- --static int device_disk_val(caml_gc *gc, libxl_device_disk *c_val, value v) --{ -- CAMLparam1(v); -- -- c_val->backend_domid = Int_val(Field(v, 0)); -- c_val->pdev_path = dup_String_val(gc, Field(v, 1)); -- c_val->vdev = dup_String_val(gc, Field(v, 2)); -- c_val->backend = (Int_val(Field(v, 3))); -- c_val->format = (Int_val(Field(v, 4))); -- c_val->unpluggable = Bool_val(Field(v, 5)); -- c_val->readwrite = Bool_val(Field(v, 6)); -- c_val->is_cdrom = Bool_val(Field(v, 7)); -- -- CAMLreturn(0); --} -- --static int device_nic_val(caml_gc *gc, libxl_device_nic *c_val, value v) --{ -- CAMLparam1(v); -- int i; -- int ret = 0; -- c_val->backend_domid = Int_val(Field(v, 0)); -- c_val->devid = Int_val(Field(v, 1)); -- c_val->mtu = Int_val(Field(v, 2)); -- c_val->model = dup_String_val(gc, Field(v, 3)); -- -- if (Wosize_val(Field(v, 4)) != 6) { -- ret = 1; -- goto out; -- } -- for (i = 0; i < 6; i++) -- c_val->mac[i] = Int_val(Field(Field(v, 4), i)); -- -- /* not handling c_val->ip */ -- c_val->bridge = dup_String_val(gc, Field(v, 5)); -- c_val->ifname = dup_String_val(gc, Field(v, 6)); -- c_val->script = dup_String_val(gc, Field(v, 7)); -- c_val->nictype = (Int_val(Field(v, 8))) + NICTYPE_IOEMU; -- --out: -- CAMLreturn(ret); --} -- --static int device_console_val(caml_gc *gc, libxl_device_console *c_val, value v) --{ -- CAMLparam1(v); -- -- c_val->backend_domid = Int_val(Field(v, 0)); -- c_val->devid = Int_val(Field(v, 1)); -- c_val->consback = (Int_val(Field(v, 2))) + LIBXL_CONSBACK_XENCONSOLED; -- -- CAMLreturn(0); --} -- --static int device_vkb_val(caml_gc *gc, libxl_device_vkb *c_val, value v) --{ -- CAMLparam1(v); -- -- c_val->backend_domid = Int_val(Field(v, 0)); -- c_val->devid = Int_val(Field(v, 1)); -- -- CAMLreturn(0); --} -- --static int device_vfb_val(caml_gc *gc, libxl_device_vfb *c_val, value v) --{ -- CAMLparam1(v); -- -- c_val->backend_domid = Int_val(Field(v, 0)); -- c_val->devid = Int_val(Field(v, 1)); -- c_val->vnc = Bool_val(Field(v, 2)); -- c_val->vnclisten = dup_String_val(gc, Field(v, 3)); -- c_val->vncpasswd = dup_String_val(gc, Field(v, 4)); -- c_val->vncdisplay = Int_val(Field(v, 5)); -- c_val->keymap = dup_String_val(gc, Field(v, 6)); -- c_val->sdl = Bool_val(Field(v, 7)); -- c_val->opengl = Bool_val(Field(v, 8)); -- c_val->display = dup_String_val(gc, Field(v, 9)); -- c_val->xauthority = dup_String_val(gc, Field(v, 10)); -- -- CAMLreturn(0); --} -- --static int device_pci_val(caml_gc *gc, libxl_device_pci *c_val, value v) --{ -- union { -- unsigned int value; -- struct { -- unsigned int reserved1:2; -- unsigned int reg:6; -- unsigned int func:3; -- unsigned int dev:5; -- unsigned int bus:8; -- unsigned int reserved2:7; -- unsigned int enable:1; -- }fields; -- }u; -- CAMLparam1(v); -- -- /* FIXME: propagate API change to ocaml */ -- u.value = Int_val(Field(v, 0)); -- c_val->reg = u.fields.reg; -- c_val->func = u.fields.func; -- c_val->dev = u.fields.dev; -- c_val->bus = u.fields.bus; -- c_val->enable = u.fields.enable; -- -- c_val->domain = Int_val(Field(v, 1)); -- c_val->vdevfn = Int_val(Field(v, 2)); -- c_val->msitranslate = Bool_val(Field(v, 3)); -- c_val->power_mgmt = Bool_val(Field(v, 4)); -- -- CAMLreturn(0); --} -- --static int sched_credit_val(caml_gc *gc, libxl_sched_credit *c_val, value v) --{ -- CAMLparam1(v); -- c_val->weight = Int_val(Field(v, 0)); -- c_val->cap = Int_val(Field(v, 1)); -- CAMLreturn(0); --} -- --static int domain_build_state_val(caml_gc *gc, libxl_domain_build_state *c_val, value v) --{ -- CAMLparam1(v); -- -- c_val->store_port = Int_val(Field(v, 0)); -- c_val->store_mfn = Int64_val(Field(v, 1)); -- c_val->console_port = Int_val(Field(v, 2)); -- c_val->console_mfn = Int64_val(Field(v, 3)); -- -- CAMLreturn(0); --} -- --static value Val_sched_credit(libxl_sched_credit *c_val) --{ -- CAMLparam0(); -- CAMLlocal1(v); -- -- v = caml_alloc_tuple(2); -- -- Store_field(v, 0, Val_int(c_val->weight)); -- Store_field(v, 1, Val_int(c_val->cap)); -- -- CAMLreturn(v); --} -- --static value Val_physinfo(libxl_physinfo *c_val) --{ -- CAMLparam0(); -- CAMLlocal2(v, hwcap); -- int i; -- -- hwcap = caml_alloc_tuple(8); -- for (i = 0; i < 8; i++) -- Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i])); -- -- v = caml_alloc_tuple(11); -- Store_field(v, 0, Val_int(c_val->threads_per_core)); -- Store_field(v, 1, Val_int(c_val->cores_per_socket)); -- Store_field(v, 2, Val_int(c_val->max_cpu_id)); -- Store_field(v, 3, Val_int(c_val->nr_cpus)); -- Store_field(v, 4, Val_int(c_val->cpu_khz)); -- Store_field(v, 5, caml_copy_int64(c_val->total_pages)); -- Store_field(v, 6, caml_copy_int64(c_val->free_pages)); -- Store_field(v, 7, caml_copy_int64(c_val->scrub_pages)); -- Store_field(v, 8, Val_int(c_val->nr_nodes)); -- Store_field(v, 9, hwcap); -- Store_field(v, 10, caml_copy_int32(c_val->phys_cap)); -- -- CAMLreturn(v); --} -- --value stub_xl_disk_add(value info, value domid) --{ -- CAMLparam2(info, domid); -- libxl_device_disk c_info; -- int ret; -- INIT_STRUCT(); -- -- device_disk_val(&gc, &c_info, info); -- c_info.domid = Int_val(domid); -- -- INIT_CTX(); -- ret = libxl_device_disk_add(&ctx, Int_val(domid), &c_info); -- if (ret != 0) -- failwith_xl("disk_add", &lg); -- FREE_CTX(); -- CAMLreturn(Val_unit); --} -- --value stub_xl_disk_remove(value info, value domid) --{ -- CAMLparam2(info, domid); -- libxl_device_disk c_info; -- int ret; -- INIT_STRUCT(); -- -- device_disk_val(&gc, &c_info, info); -- c_info.domid = Int_val(domid); -- -- INIT_CTX(); -- ret = libxl_device_disk_del(&ctx, &c_info, 0); -- if (ret != 0) -- failwith_xl("disk_remove", &lg); -- FREE_CTX(); -- CAMLreturn(Val_unit); --} -- --value stub_xl_nic_add(value info, value domid) --{ -- CAMLparam2(info, domid); -- libxl_device_nic c_info; -- int ret; -- INIT_STRUCT(); -- -- device_nic_val(&gc, &c_info, info); -- c_info.domid = Int_val(domid); -- -- INIT_CTX(); -- ret = libxl_device_nic_add(&ctx, Int_val(domid), &c_info); -- if (ret != 0) -- failwith_xl("nic_add", &lg); -- FREE_CTX(); -- CAMLreturn(Val_unit); --} -- --value stub_xl_nic_remove(value info, value domid) --{ -- CAMLparam2(info, domid); -- libxl_device_nic c_info; -- int ret; -- INIT_STRUCT(); -- -- device_nic_val(&gc, &c_info, info); -- c_info.domid = Int_val(domid); -- -- INIT_CTX(); -- ret = libxl_device_nic_del(&ctx, &c_info, 0); -- if (ret != 0) -- failwith_xl("nic_remove", &lg); -- FREE_CTX(); -- CAMLreturn(Val_unit); --} -- --value stub_xl_console_add(value info, value state, value domid) --{ -- CAMLparam3(info, state, domid); -- libxl_device_console c_info; -- libxl_domain_build_state c_state; -- int ret; -- INIT_STRUCT(); -- -- device_console_val(&gc, &c_info, info); -- domain_build_state_val(&gc, &c_state, state); -- c_info.domid = Int_val(domid); -- c_info.build_state = &c_state; -- -- INIT_CTX(); -- ret = libxl_device_console_add(&ctx, Int_val(domid), &c_info); -- if (ret != 0) -- failwith_xl("console_add", &lg); -- FREE_CTX(); -- CAMLreturn(Val_unit); --} -- --value stub_xl_vkb_add(value info, value domid) --{ -- CAMLparam2(info, domid); -- libxl_device_vkb c_info; -- int ret; -- INIT_STRUCT(); -- -- device_vkb_val(&gc, &c_info, info); -- c_info.domid = Int_val(domid); -- -- INIT_CTX(); -- ret = libxl_device_vkb_add(&ctx, Int_val(domid), &c_info); -- if (ret != 0) -- failwith_xl("vkb_add", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_vkb_clean_shutdown(value domid) --{ -- CAMLparam1(domid); -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_device_vkb_clean_shutdown(&ctx, Int_val(domid)); -- if (ret != 0) -- failwith_xl("vkb_clean_shutdown", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_vkb_hard_shutdown(value domid) --{ -- CAMLparam1(domid); -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_device_vkb_hard_shutdown(&ctx, Int_val(domid)); -- if (ret != 0) -- failwith_xl("vkb_hard_shutdown", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_vfb_add(value info, value domid) --{ -- CAMLparam2(info, domid); -- libxl_device_vfb c_info; -- int ret; -- INIT_STRUCT(); -- -- device_vfb_val(&gc, &c_info, info); -- c_info.domid = Int_val(domid); -- -- INIT_CTX(); -- ret = libxl_device_vfb_add(&ctx, Int_val(domid), &c_info); -- if (ret != 0) -- failwith_xl("vfb_add", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_vfb_clean_shutdown(value domid) --{ -- CAMLparam1(domid); -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_device_vfb_clean_shutdown(&ctx, Int_val(domid)); -- if (ret != 0) -- failwith_xl("vfb_clean_shutdown", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_vfb_hard_shutdown(value domid) --{ -- CAMLparam1(domid); -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_device_vfb_hard_shutdown(&ctx, Int_val(domid)); -- if (ret != 0) -- failwith_xl("vfb_hard_shutdown", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_pci_add(value info, value domid) --{ -- CAMLparam2(info, domid); -- libxl_device_pci c_info; -- int ret; -- INIT_STRUCT(); -- -- device_pci_val(&gc, &c_info, info); -- -- INIT_CTX(); -- ret = libxl_device_pci_add(&ctx, Int_val(domid), &c_info); -- if (ret != 0) -- failwith_xl("pci_add", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_pci_remove(value info, value domid) --{ -- CAMLparam2(info, domid); -- libxl_device_pci c_info; -- int ret; -- INIT_STRUCT(); -- -- device_pci_val(&gc, &c_info, info); -- -- INIT_CTX(); -- ret = libxl_device_pci_remove(&ctx, Int_val(domid), &c_info, 0); -- if (ret != 0) -- failwith_xl("pci_remove", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_pci_shutdown(value domid) --{ -- CAMLparam1(domid); -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_device_pci_shutdown(&ctx, Int_val(domid)); -- if (ret != 0) -- failwith_xl("pci_shutdown", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_button_press(value domid, value button) --{ -- CAMLparam2(domid, button); -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_button_press(&ctx, Int_val(domid), Int_val(button) + POWER_BUTTON); -- if (ret != 0) -- failwith_xl("button_press", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_physinfo(value unit) --{ -- CAMLparam1(unit); -- CAMLlocal1(physinfo); -- libxl_physinfo c_physinfo; -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_get_physinfo(&ctx, &c_physinfo); -- if (ret != 0) -- failwith_xl("physinfo", &lg); -- FREE_CTX(); -- -- physinfo = Val_physinfo(&c_physinfo); -- CAMLreturn(physinfo); --} -- --value stub_xl_sched_credit_domain_get(value domid) --{ -- CAMLparam1(domid); -- CAMLlocal1(scinfo); -- libxl_sched_credit c_scinfo; -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_sched_credit_domain_get(&ctx, Int_val(domid), &c_scinfo); -- if (ret != 0) -- failwith_xl("sched_credit_domain_get", &lg); -- FREE_CTX(); -- -- scinfo = Val_sched_credit(&c_scinfo); -- CAMLreturn(scinfo); --} -- --value stub_xl_sched_credit_domain_set(value domid, value scinfo) --{ -- CAMLparam2(domid, scinfo); -- libxl_sched_credit c_scinfo; -- int ret; -- INIT_STRUCT(); -- -- sched_credit_val(&gc, &c_scinfo, scinfo); -- -- INIT_CTX(); -- ret = libxl_sched_credit_domain_set(&ctx, Int_val(domid), &c_scinfo); -- if (ret != 0) -- failwith_xl("sched_credit_domain_set", &lg); -- FREE_CTX(); -- -- CAMLreturn(Val_unit); --} -- --value stub_xl_send_trigger(value domid, value trigger, value vcpuid) --{ -- CAMLparam3(domid, trigger, vcpuid); -- int ret; -- char *c_trigger; -- INIT_STRUCT(); -- -- c_trigger = dup_String_val(&gc, trigger); -- -- INIT_CTX(); -- ret = libxl_send_trigger(&ctx, Int_val(domid), c_trigger, Int_val(vcpuid)); -- if (ret != 0) -- failwith_xl("send_trigger", &lg); -- FREE_CTX(); -- CAMLreturn(Val_unit); --} -- --value stub_xl_send_sysrq(value domid, value sysrq) --{ -- CAMLparam2(domid, sysrq); -- int ret; -- INIT_STRUCT(); -- -- INIT_CTX(); -- ret = libxl_send_sysrq(&ctx, Int_val(domid), Int_val(sysrq)); -- if (ret != 0) -- failwith_xl("send_sysrq", &lg); -- FREE_CTX(); -- CAMLreturn(Val_unit); --} -- --value stub_xl_send_debug_keys(value keys) --{ -- CAMLparam1(keys); -- int ret; -- char *c_keys; -- INIT_STRUCT(); -- -- c_keys = dup_String_val(&gc, keys); -- -- INIT_CTX(); -- ret = libxl_send_debug_keys(&ctx, c_keys); -- if (ret != 0) -- failwith_xl("send_debug_keys", &lg); -- FREE_CTX(); -- CAMLreturn(Val_unit); --} -- --/* -- * Local variables: -- * indent-tabs-mode: t -- * c-basic-offset: 8 -- * tab-width: 8 -- * End: -- */ ---- a/tools/ocaml/libs/xs/META.in -+++ b/tools/ocaml/libs/xs/META.in -@@ -1,5 +1,5 @@ - version = "@VERSION@" - description = "XenStore Interface" --requires = "unix,xb" --archive(byte) = "xs.cma" --archive(native) = "xs.cmxa" -+requires = "unix,xenbus" -+archive(byte) = "xenstore.cma" -+archive(native) = "xenstore.cmxa" ---- a/tools/ocaml/libs/xs/Makefile -+++ b/tools/ocaml/libs/xs/Makefile -@@ -3,6 +3,7 @@ - include $(TOPLEVEL)/common.make - - OCAMLINCLUDE += -I ../xb/ -+OCAMLOPTFLAGS += -for-pack Xenstore - - .NOTPARALLEL: - # Ocaml is such a PITA! -@@ -12,7 +13,7 @@ - PRELIBS = $(foreach obj, $(PREOBJS),$(obj).cmo) $(foreach obj,$(PREOJBS),$(obj).cmx) - OBJS = queueop xsraw xst xs - INTF = xsraw.cmi xst.cmi xs.cmi --LIBS = xs.cma xs.cmxa -+LIBS = xenstore.cma xenstore.cmxa - - all: $(PREINTF) $(PRELIBS) $(INTF) $(LIBS) $(PROGRAMS) - -@@ -20,26 +21,26 @@ - - libs: $(LIBS) - --xs_OBJS = $(OBJS) --OCAML_NOC_LIBRARY = xs -+xenstore_OBJS = xenstore -+OCAML_NOC_LIBRARY = xenstore - --#xs.cmxa: $(foreach obj,$(OBJS),$(obj).cmx) --# $(E) " MLLIB $@" --# $(Q)$(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o $@ $(foreach obj,$(OBJS),$(obj).cmx) --# --#xs.cma: $(foreach obj,$(OBJS),$(obj).cmo) --# $(E) " MLLIB $@" --# $(Q)$(OCAMLC) -a -o $@ $(foreach obj,$(OBJS),$(obj).cmo) -+xenstore.cmx : $(foreach obj, $(OBJS), $(obj).cmx) -+ $(E) " CMX $@" -+ $(Q)$(OCAMLOPT) -pack -o $@ $^ -+ -+xenstore.cmo : $(foreach obj, $(OBJS), $(obj).cmo) -+ $(E) " CMO $@" -+ $(Q)$(OCAMLC) -pack -o $@ $^ - - .PHONY: install - install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) -- ocamlfind remove -destdir $(OCAMLDESTDIR) xs -- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xs META $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a *.cmx -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore -+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenstore META $(LIBS) xenstore.cmx xenstore.cmi *.a - - .PHONY: uninstall - uninstall: -- ocamlfind remove -destdir $(OCAMLDESTDIR) xs -+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore - - include $(TOPLEVEL)/Makefile.rules - ---- a/tools/ocaml/libs/xs/queueop.ml -+++ b/tools/ocaml/libs/xs/queueop.ml -@@ -13,6 +13,7 @@ - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -+open Xenbus - - let data_concat ls = (String.concat "\000" ls) ^ "\000" - let queue_path ty (tid: int) (path: string) con = ---- a/tools/ocaml/libs/xs/xs.ml -+++ b/tools/ocaml/libs/xs/xs.ml -@@ -69,7 +69,7 @@ - let read_watchevent xsh = Xsraw.read_watchevent xsh.con - - let make fd = get_operations (Xsraw.open_fd fd) --let get_fd xsh = Xb.get_fd xsh.con.Xsraw.xb -+let get_fd xsh = Xenbus.Xb.get_fd xsh.con.Xsraw.xb - - exception Timeout - ---- a/tools/ocaml/libs/xs/xsraw.ml -+++ b/tools/ocaml/libs/xs/xsraw.ml -@@ -14,6 +14,8 @@ - * GNU Lesser General Public License for more details. - *) - -+open Xenbus -+ - exception Partial_not_empty - exception Unexpected_packet of string - -@@ -27,7 +29,7 @@ - raise (Unexpected_packet s) - - type con = { -- xb: Xb.t; -+ xb: Xenbus.Xb.t; - watchevents: (string * string) Queue.t; - } - ---- a/tools/ocaml/libs/xs/xsraw.mli -+++ b/tools/ocaml/libs/xs/xsraw.mli -@@ -16,8 +16,8 @@ - exception Partial_not_empty - exception Unexpected_packet of string - exception Invalid_path of string --val unexpected_packet : Xb.Op.operation -> Xb.Op.operation -> 'a --type con = { xb : Xb.t; watchevents : (string * string) Queue.t; } -+val unexpected_packet : Xenbus.Xb.Op.operation -> Xenbus.Xb.Op.operation -> 'a -+type con = { xb : Xenbus.Xb.t; watchevents : (string * string) Queue.t; } - val close : con -> unit - val open_fd : Unix.file_descr -> con - val split_string : ?limit:int -> char -> string -> string list -@@ -26,14 +26,14 @@ - val string_of_perms : int * perm * (int * perm) list -> string - val perms_of_string : string -> int * perm * (int * perm) list - val pkt_send : con -> unit --val pkt_recv : con -> Xb.Packet.t --val pkt_recv_timeout : con -> float -> bool * Xb.Packet.t option -+val pkt_recv : con -> Xenbus.Xb.Packet.t -+val pkt_recv_timeout : con -> float -> bool * Xenbus.Xb.Packet.t option - val queue_watchevent : con -> string -> unit - val has_watchevents : con -> bool - val get_watchevent : con -> string * string - val read_watchevent : con -> string * string --val sync_recv : Xb.Op.operation -> con -> string --val sync : (Xb.t -> 'a) -> con -> string -+val sync_recv : Xenbus.Xb.Op.operation -> con -> string -+val sync : (Xenbus.Xb.t -> 'a) -> con -> string - val ack : string -> unit - val validate_path : string -> unit - val validate_watch_path : string -> unit ---- a/tools/ocaml/xenstored/Makefile -+++ b/tools/ocaml/xenstored/Makefile -@@ -35,11 +35,11 @@ - XENSTOREDLIBS = \ - unix.cmxa \ - $(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \ -- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \ -+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \ -- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \ -- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xc.cmxa \ -- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xb.cmxa \ -+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \ -+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \ -+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xenbus.cmxa \ - -ccopt -L -ccopt $(XEN_ROOT)/tools/libxc - - PROGRAMS = oxenstored ---- a/tools/ocaml/xenstored/connection.ml -+++ b/tools/ocaml/xenstored/connection.ml -@@ -27,7 +27,7 @@ - } - - and t = { -- xb: Xb.t; -+ xb: Xenbus.Xb.t; - dom: Domain.t option; - transactions: (int, Transaction.t) Hashtbl.t; - mutable next_tid: int; -@@ -93,10 +93,10 @@ - Logging.new_connection ~tid:Transaction.none ~con:(get_domstr con); - con - --let get_fd con = Xb.get_fd con.xb -+let get_fd con = Xenbus.Xb.get_fd con.xb - let close con = - Logging.end_connection ~tid:Transaction.none ~con:(get_domstr con); -- Xb.close con.xb -+ Xenbus.Xb.close con.xb - - let get_perm con = - con.perm -@@ -108,9 +108,9 @@ - con.perm <- Perms.Connection.set_target (get_perm con) ~perms:[Perms.READ; Perms.WRITE] target_domid - - let send_reply con tid rid ty data = -- Xb.queue con.xb (Xb.Packet.create tid rid ty data) -+ Xenbus.Xb.queue con.xb (Xenbus.Xb.Packet.create tid rid ty data) - --let send_error con tid rid err = send_reply con tid rid Xb.Op.Error (err ^ "\000") -+let send_error con tid rid err = send_reply con tid rid Xenbus.Xb.Op.Error (err ^ "\000") - let send_ack con tid rid ty = send_reply con tid rid ty "OK\000" - - let get_watch_path con path = -@@ -166,7 +166,7 @@ - - let fire_single_watch watch = - let data = Utils.join_by_null [watch.path; watch.token; ""] in -- send_reply watch.con Transaction.none 0 Xb.Op.Watchevent data -+ send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data - - let fire_watch watch path = - let new_path = -@@ -179,7 +179,7 @@ - path - in - let data = Utils.join_by_null [ new_path; watch.token; "" ] in -- send_reply watch.con Transaction.none 0 Xb.Op.Watchevent data -+ send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data - - let find_next_tid con = - let ret = con.next_tid in con.next_tid <- con.next_tid + 1; ret -@@ -203,15 +203,15 @@ - let get_transaction con tid = - Hashtbl.find con.transactions tid - --let do_input con = Xb.input con.xb --let has_input con = Xb.has_in_packet con.xb --let pop_in con = Xb.get_in_packet con.xb --let has_more_input con = Xb.has_more_input con.xb -- --let has_output con = Xb.has_output con.xb --let has_new_output con = Xb.has_new_output con.xb --let peek_output con = Xb.peek_output con.xb --let do_output con = Xb.output con.xb -+let do_input con = Xenbus.Xb.input con.xb -+let has_input con = Xenbus.Xb.has_in_packet con.xb -+let pop_in con = Xenbus.Xb.get_in_packet con.xb -+let has_more_input con = Xenbus.Xb.has_more_input con.xb -+ -+let has_output con = Xenbus.Xb.has_output con.xb -+let has_new_output con = Xenbus.Xb.has_new_output con.xb -+let peek_output con = Xenbus.Xb.peek_output con.xb -+let do_output con = Xenbus.Xb.output con.xb - - let incr_ops con = con.stat_nb_ops <- con.stat_nb_ops + 1 - ---- a/tools/ocaml/xenstored/connections.ml -+++ b/tools/ocaml/xenstored/connections.ml -@@ -26,12 +26,12 @@ - let create () = { anonymous = []; domains = Hashtbl.create 8; watches = Trie.create () } - - let add_anonymous cons fd can_write = -- let xbcon = Xb.open_fd fd in -+ let xbcon = Xenbus.Xb.open_fd fd in - let con = Connection.create xbcon None in - cons.anonymous <- con :: cons.anonymous - - let add_domain cons dom = -- let xbcon = Xb.open_mmap (Domain.get_interface dom) (fun () -> Domain.notify dom) in -+ let xbcon = Xenbus.Xb.open_mmap (Domain.get_interface dom) (fun () -> Domain.notify dom) in - let con = Connection.create xbcon (Some dom) in - Hashtbl.add cons.domains (Domain.get_id dom) con - ---- a/tools/ocaml/xenstored/domain.ml -+++ b/tools/ocaml/xenstored/domain.ml -@@ -20,10 +20,10 @@ - - type t = - { -- id: Xc.domid; -+ id: Xenctrl.domid; - mfn: nativeint; - remote_port: int; -- interface: Mmap.mmap_interface; -+ interface: Xenmmap.mmap_interface; - eventchn: Event.t; - mutable port: int; - } -@@ -47,7 +47,7 @@ - let close dom = - debug "domain %d unbound port %d" dom.id dom.port; - Event.unbind dom.eventchn dom.port; -- Mmap.unmap dom.interface; -+ Xenmmap.unmap dom.interface; - () - - let make id mfn remote_port interface eventchn = { ---- a/tools/ocaml/xenstored/domains.ml -+++ b/tools/ocaml/xenstored/domains.ml -@@ -16,7 +16,7 @@ - - type domains = { - eventchn: Event.t; -- table: (Xc.domid, Domain.t) Hashtbl.t; -+ table: (Xenctrl.domid, Domain.t) Hashtbl.t; - } - - let init eventchn = -@@ -33,16 +33,16 @@ - - Hashtbl.iter (fun id _ -> if id <> 0 then - try -- let info = Xc.domain_getinfo xc id in -- if info.Xc.shutdown || info.Xc.dying then ( -+ let info = Xenctrl.domain_getinfo xc id in -+ if info.Xenctrl.shutdown || info.Xenctrl.dying then ( - Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)" -- id info.Xc.dying info.Xc.shutdown info.Xc.shutdown_code; -- if info.Xc.dying then -+ id info.Xenctrl.dying info.Xenctrl.shutdown info.Xenctrl.shutdown_code; -+ if info.Xenctrl.dying then - dead_dom := id :: !dead_dom - else - notify := true; - ) -- with Xc.Error _ -> -+ with Xenctrl.Error _ -> - Logs.debug "general" "Domain %u died -- no domain info" id; - dead_dom := id :: !dead_dom; - ) doms.table; -@@ -57,7 +57,7 @@ - () - - let create xc doms domid mfn port = -- let interface = Xc.map_foreign_range xc domid (Mmap.getpagesize()) mfn in -+ let interface = Xenctrl.map_foreign_range xc domid (Xenmmap.getpagesize()) mfn in - let dom = Domain.make domid mfn port interface doms.eventchn in - Hashtbl.add doms.table domid dom; - Domain.bind_interdomain dom; -@@ -66,13 +66,13 @@ - let create0 fake doms = - let port, interface = - if fake then ( -- 0, Xc.with_intf (fun xc -> Xc.map_foreign_range xc 0 (Mmap.getpagesize()) 0n) -+ 0, Xenctrl.with_intf (fun xc -> Xenctrl.map_foreign_range xc 0 (Xenmmap.getpagesize()) 0n) - ) else ( - let port = Utils.read_file_single_integer Define.xenstored_proc_port - and fd = Unix.openfile Define.xenstored_proc_kva - [ Unix.O_RDWR ] 0o600 in -- let interface = Mmap.mmap fd Mmap.RDWR Mmap.SHARED -- (Mmap.getpagesize()) 0 in -+ let interface = Xenmmap.mmap fd Xenmmap.RDWR Xenmmap.SHARED -+ (Xenmmap.getpagesize()) 0 in - Unix.close fd; - port, interface - ) ---- a/tools/ocaml/xenstored/event.ml -+++ b/tools/ocaml/xenstored/event.ml -@@ -16,15 +16,15 @@ - - (**************** high level binding ****************) - type t = { -- handle: Eventchn.handle; -+ handle: Xeneventchn.handle; - mutable virq_port: int; - } - --let init () = { handle = Eventchn.init (); virq_port = -1; } --let fd eventchn = Eventchn.fd eventchn.handle --let bind_dom_exc_virq eventchn = eventchn.virq_port <- Eventchn.bind_dom_exc_virq eventchn.handle --let bind_interdomain eventchn domid port = Eventchn.bind_interdomain eventchn.handle domid port --let unbind eventchn port = Eventchn.unbind eventchn.handle port --let notify eventchn port = Eventchn.notify eventchn.handle port --let pending eventchn = Eventchn.pending eventchn.handle --let unmask eventchn port = Eventchn.unmask eventchn.handle port -+let init () = { handle = Xeneventchn.init (); virq_port = -1; } -+let fd eventchn = Xeneventchn.fd eventchn.handle -+let bind_dom_exc_virq eventchn = eventchn.virq_port <- Xeneventchn.bind_dom_exc_virq eventchn.handle -+let bind_interdomain eventchn domid port = Xeneventchn.bind_interdomain eventchn.handle domid port -+let unbind eventchn port = Xeneventchn.unbind eventchn.handle port -+let notify eventchn port = Xeneventchn.notify eventchn.handle port -+let pending eventchn = Xeneventchn.pending eventchn.handle -+let unmask eventchn port = Xeneventchn.unmask eventchn.handle port ---- a/tools/ocaml/xenstored/logging.ml -+++ b/tools/ocaml/xenstored/logging.ml -@@ -39,7 +39,7 @@ - | Commit - | Newconn - | Endconn -- | XbOp of Xb.Op.operation -+ | XbOp of Xenbus.Xb.Op.operation - - type access = - { -@@ -82,35 +82,35 @@ - | Endconn -> "endconn " - - | XbOp op -> match op with -- | Xb.Op.Debug -> "debug " -+ | Xenbus.Xb.Op.Debug -> "debug " - -- | Xb.Op.Directory -> "directory" -- | Xb.Op.Read -> "read " -- | Xb.Op.Getperms -> "getperms " -- -- | Xb.Op.Watch -> "watch " -- | Xb.Op.Unwatch -> "unwatch " -- -- | Xb.Op.Transaction_start -> "t start " -- | Xb.Op.Transaction_end -> "t end " -- -- | Xb.Op.Introduce -> "introduce" -- | Xb.Op.Release -> "release " -- | Xb.Op.Getdomainpath -> "getdomain" -- | Xb.Op.Isintroduced -> "is introduced" -- | Xb.Op.Resume -> "resume " -+ | Xenbus.Xb.Op.Directory -> "directory" -+ | Xenbus.Xb.Op.Read -> "read " -+ | Xenbus.Xb.Op.Getperms -> "getperms " -+ -+ | Xenbus.Xb.Op.Watch -> "watch " -+ | Xenbus.Xb.Op.Unwatch -> "unwatch " -+ -+ | Xenbus.Xb.Op.Transaction_start -> "t start " -+ | Xenbus.Xb.Op.Transaction_end -> "t end " -+ -+ | Xenbus.Xb.Op.Introduce -> "introduce" -+ | Xenbus.Xb.Op.Release -> "release " -+ | Xenbus.Xb.Op.Getdomainpath -> "getdomain" -+ | Xenbus.Xb.Op.Isintroduced -> "is introduced" -+ | Xenbus.Xb.Op.Resume -> "resume " - -- | Xb.Op.Write -> "write " -- | Xb.Op.Mkdir -> "mkdir " -- | Xb.Op.Rm -> "rm " -- | Xb.Op.Setperms -> "setperms " -- | Xb.Op.Restrict -> "restrict " -- | Xb.Op.Set_target -> "settarget" -+ | Xenbus.Xb.Op.Write -> "write " -+ | Xenbus.Xb.Op.Mkdir -> "mkdir " -+ | Xenbus.Xb.Op.Rm -> "rm " -+ | Xenbus.Xb.Op.Setperms -> "setperms " -+ | Xenbus.Xb.Op.Restrict -> "restrict " -+ | Xenbus.Xb.Op.Set_target -> "settarget" - -- | Xb.Op.Error -> "error " -- | Xb.Op.Watchevent -> "w event " -+ | Xenbus.Xb.Op.Error -> "error " -+ | Xenbus.Xb.Op.Watchevent -> "w event " - -- | x -> Xb.Op.to_string x -+ | x -> Xenbus.Xb.Op.to_string x - - let file_exists file = - try -@@ -210,10 +210,10 @@ - let xb_op ~tid ~con ~ty data = - let print = - match ty with -- | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !log_read_ops -- | Xb.Op.Transaction_start | Xb.Op.Transaction_end -> -+ | Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !log_read_ops -+ | Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end -> - false (* transactions are managed below *) -- | Xb.Op.Introduce | Xb.Op.Release | Xb.Op.Getdomainpath | Xb.Op.Isintroduced | Xb.Op.Resume -> -+ | Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume -> - !log_special_ops - | _ -> true - in -@@ -222,17 +222,17 @@ - - let start_transaction ~tid ~con = - if !log_transaction_ops && tid <> 0 -- then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_start) -+ then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start) - - let end_transaction ~tid ~con = - if !log_transaction_ops && tid <> 0 -- then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_end) -+ then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end) - - let xb_answer ~tid ~con ~ty data = - let print = match ty with -- | Xb.Op.Error when data="ENOENT " -> !log_read_ops -- | Xb.Op.Error -> !log_special_ops -- | Xb.Op.Watchevent -> true -+ | Xenbus.Xb.Op.Error when data="ENOENT " -> !log_read_ops -+ | Xenbus.Xb.Op.Error -> !log_special_ops -+ | Xenbus.Xb.Op.Watchevent -> true - | _ -> false - in - if print ---- a/tools/ocaml/xenstored/perms.ml -+++ b/tools/ocaml/xenstored/perms.ml -@@ -43,9 +43,9 @@ - - type t = - { -- owner: Xc.domid; -+ owner: Xenctrl.domid; - other: permty; -- acl: (Xc.domid * permty) list; -+ acl: (Xenctrl.domid * permty) list; - } - - let create owner other acl = -@@ -88,7 +88,7 @@ - module Connection = - struct - --type elt = Xc.domid * (permty list) -+type elt = Xenctrl.domid * (permty list) - type t = - { main: elt; - target: elt option; } ---- a/tools/ocaml/xenstored/process.ml -+++ b/tools/ocaml/xenstored/process.ml -@@ -54,10 +54,10 @@ - let process_watch ops cons = - let do_op_watch op cons = - let recurse = match (fst op) with -- | Xb.Op.Write -> false -- | Xb.Op.Mkdir -> false -- | Xb.Op.Rm -> true -- | Xb.Op.Setperms -> false -+ | Xenbus.Xb.Op.Write -> false -+ | Xenbus.Xb.Op.Mkdir -> false -+ | Xenbus.Xb.Op.Rm -> true -+ | Xenbus.Xb.Op.Setperms -> false - | _ -> raise (Failure "huh ?") in - Connections.fire_watches cons (snd op) recurse in - List.iter (fun op -> do_op_watch op cons) ops -@@ -83,7 +83,7 @@ - then None - else try match split None '\000' data with - | "print" :: msg :: _ -> -- Logging.xb_op ~tid:0 ~ty:Xb.Op.Debug ~con:"=======>" msg; -+ Logging.xb_op ~tid:0 ~ty:Xenbus.Xb.Op.Debug ~con:"=======>" msg; - None - | "quota" :: domid :: _ -> - let domid = int_of_string domid in -@@ -120,7 +120,7 @@ - | _ -> raise Invalid_Cmd_Args - in - let watch = Connections.add_watch cons con node token in -- Connection.send_ack con (Transaction.get_id t) rid Xb.Op.Watch; -+ Connection.send_ack con (Transaction.get_id t) rid Xenbus.Xb.Op.Watch; - Connection.fire_single_watch watch - - let do_unwatch con t domains cons data = -@@ -165,7 +165,7 @@ - if Domains.exist domains domid then - Domains.find domains domid - else try -- let ndom = Xc.with_intf (fun xc -> -+ let ndom = Xenctrl.with_intf (fun xc -> - Domains.create xc domains domid mfn port) in - Connections.add_domain cons ndom; - Connections.fire_spec_watches cons "@introduceDomain"; -@@ -299,25 +299,25 @@ - - let function_of_type ty = - match ty with -- | Xb.Op.Debug -> reply_data_or_ack do_debug -- | Xb.Op.Directory -> reply_data do_directory -- | Xb.Op.Read -> reply_data do_read -- | Xb.Op.Getperms -> reply_data do_getperms -- | Xb.Op.Watch -> reply_none do_watch -- | Xb.Op.Unwatch -> reply_ack do_unwatch -- | Xb.Op.Transaction_start -> reply_data do_transaction_start -- | Xb.Op.Transaction_end -> reply_ack do_transaction_end -- | Xb.Op.Introduce -> reply_ack do_introduce -- | Xb.Op.Release -> reply_ack do_release -- | Xb.Op.Getdomainpath -> reply_data do_getdomainpath -- | Xb.Op.Write -> reply_ack do_write -- | Xb.Op.Mkdir -> reply_ack do_mkdir -- | Xb.Op.Rm -> reply_ack do_rm -- | Xb.Op.Setperms -> reply_ack do_setperms -- | Xb.Op.Isintroduced -> reply_data do_isintroduced -- | Xb.Op.Resume -> reply_ack do_resume -- | Xb.Op.Set_target -> reply_ack do_set_target -- | Xb.Op.Restrict -> reply_ack do_restrict -+ | Xenbus.Xb.Op.Debug -> reply_data_or_ack do_debug -+ | Xenbus.Xb.Op.Directory -> reply_data do_directory -+ | Xenbus.Xb.Op.Read -> reply_data do_read -+ | Xenbus.Xb.Op.Getperms -> reply_data do_getperms -+ | Xenbus.Xb.Op.Watch -> reply_none do_watch -+ | Xenbus.Xb.Op.Unwatch -> reply_ack do_unwatch -+ | Xenbus.Xb.Op.Transaction_start -> reply_data do_transaction_start -+ | Xenbus.Xb.Op.Transaction_end -> reply_ack do_transaction_end -+ | Xenbus.Xb.Op.Introduce -> reply_ack do_introduce -+ | Xenbus.Xb.Op.Release -> reply_ack do_release -+ | Xenbus.Xb.Op.Getdomainpath -> reply_data do_getdomainpath -+ | Xenbus.Xb.Op.Write -> reply_ack do_write -+ | Xenbus.Xb.Op.Mkdir -> reply_ack do_mkdir -+ | Xenbus.Xb.Op.Rm -> reply_ack do_rm -+ | Xenbus.Xb.Op.Setperms -> reply_ack do_setperms -+ | Xenbus.Xb.Op.Isintroduced -> reply_data do_isintroduced -+ | Xenbus.Xb.Op.Resume -> reply_ack do_resume -+ | Xenbus.Xb.Op.Set_target -> reply_ack do_set_target -+ | Xenbus.Xb.Op.Restrict -> reply_ack do_restrict - | _ -> reply_ack do_error - - let input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data = -@@ -370,11 +370,11 @@ - let do_input store cons doms con = - if Connection.do_input con then ( - let packet = Connection.pop_in con in -- let tid, rid, ty, data = Xb.Packet.unpack packet in -+ let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in - (* As we don't log IO, do not call an unnecessary sanitize_data - Logs.info "io" "[%s] -> [%d] %s \"%s\"" - (Connection.get_domstr con) tid -- (Xb.Op.to_string ty) (sanitize_data data); *) -+ (Xenbus.Xb.Op.to_string ty) (sanitize_data data); *) - process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data; - write_access_log ~ty ~tid ~con ~data; - Connection.incr_ops con; -@@ -384,11 +384,11 @@ - if Connection.has_output con then ( - if Connection.has_new_output con then ( - let packet = Connection.peek_output con in -- let tid, rid, ty, data = Xb.Packet.unpack packet in -+ let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in - (* As we don't log IO, do not call an unnecessary sanitize_data - Logs.info "io" "[%s] <- %s \"%s\"" - (Connection.get_domstr con) -- (Xb.Op.to_string ty) (sanitize_data data);*) -+ (Xenbus.Xb.Op.to_string ty) (sanitize_data data);*) - write_answer_log ~ty ~tid ~con ~data; - ); - ignore (Connection.do_output con) ---- a/tools/ocaml/xenstored/quota.ml -+++ b/tools/ocaml/xenstored/quota.ml -@@ -26,7 +26,7 @@ - type t = { - maxent: int; (* max entities per domU *) - maxsize: int; (* max size of data store in one node *) -- cur: (Xc.domid, int) Hashtbl.t; (* current domains quota *) -+ cur: (Xenctrl.domid, int) Hashtbl.t; (* current domains quota *) - } - - let to_string quota domid = ---- a/tools/ocaml/xenstored/transaction.ml -+++ b/tools/ocaml/xenstored/transaction.ml -@@ -74,7 +74,7 @@ - type t = { - ty: ty; - store: Store.t; -- mutable ops: (Xb.Op.operation * Store.Path.t) list; -+ mutable ops: (Xenbus.Xb.Op.operation * Store.Path.t) list; - mutable read_lowpath: Store.Path.t option; - mutable write_lowpath: Store.Path.t option; - } -@@ -105,23 +105,23 @@ - if path_exists - then set_write_lowpath t path - else set_write_lowpath t (Store.Path.get_parent path); -- add_wop t Xb.Op.Write path -+ add_wop t Xenbus.Xb.Op.Write path - - let mkdir ?(with_watch=true) t perm path = - Store.mkdir t.store perm path; - set_write_lowpath t path; - if with_watch then -- add_wop t Xb.Op.Mkdir path -+ add_wop t Xenbus.Xb.Op.Mkdir path - - let setperms t perm path perms = - Store.setperms t.store perm path perms; - set_write_lowpath t path; -- add_wop t Xb.Op.Setperms path -+ add_wop t Xenbus.Xb.Op.Setperms path - - let rm t perm path = - Store.rm t.store perm path; - set_write_lowpath t (Store.Path.get_parent path); -- add_wop t Xb.Op.Rm path -+ add_wop t Xenbus.Xb.Op.Rm path - - let ls t perm path = - let r = Store.ls t.store perm path in ---- a/tools/ocaml/xenstored/xenstored.ml -+++ b/tools/ocaml/xenstored/xenstored.ml -@@ -35,7 +35,7 @@ - if err <> Unix.ECONNRESET then - error "closing socket connection: read error: %s" - (Unix.error_message err) -- | Xb.End_of_file -> -+ | Xenbus.Xb.End_of_file -> - Connections.del_anonymous cons c; - debug "closing socket connection" - in -@@ -170,7 +170,7 @@ - let from_channel store cons doms chan = - (* don't let the permission get on our way, full perm ! *) - let op = Store.get_ops store Perms.Connection.full_rights in -- let xc = Xc.interface_open () in -+ let xc = Xenctrl.interface_open () in - - let domain_f domid mfn port = - let ndom = -@@ -190,7 +190,7 @@ - op.Store.setperms path perms - in - finally (fun () -> from_channel_f chan domain_f watch_f store_f) -- (fun () -> Xc.interface_close xc) -+ (fun () -> Xenctrl.interface_close xc) - - let from_file store cons doms file = - let channel = open_in file in -@@ -282,7 +282,7 @@ - Store.mkdir store (Perms.Connection.create 0) localpath; - - if cf.domain_init then ( -- let usingxiu = Xc.is_fake () in -+ let usingxiu = Xenctrl.is_fake () in - Connections.add_domain cons (Domains.create0 usingxiu domains); - Event.bind_dom_exc_virq eventchn - ); -@@ -301,7 +301,7 @@ - (if cf.domain_init then [ Event.fd eventchn ] else []) - in - -- let xc = Xc.interface_open () in -+ let xc = Xenctrl.interface_open () in - - let process_special_fds rset = - let accept_connection can_write fd = ---- a/tools/ocaml/libs/xl/xl.ml -+++ /dev/null -@@ -1,213 +0,0 @@ --(* -- * Copyright (C) 2009-2010 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- *) -- --exception Error of string -- --type create_info = --{ -- hvm : bool; -- hap : bool; -- oos : bool; -- ssidref : int32; -- name : string; -- uuid : int array; -- xsdata : (string * string) list; -- platformdata : (string * string) list; -- poolid : int32; -- poolname : string; --} -- --type build_pv_info = --{ -- slack_memkb : int64; -- cmdline : string; -- ramdisk : string; -- features : string; --} -- --type build_hvm_info = --{ -- pae : bool; -- apic : bool; -- acpi : bool; -- nx : bool; -- viridian : bool; -- timeoffset : string; -- timer_mode : int; -- hpet : int; -- vpt_align : int; --} -- --type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info -- --type build_info = --{ -- max_vcpus : int; -- cur_vcpus : int; -- max_memkb : int64; -- target_memkb : int64; -- video_memkb : int64; -- shadow_memkb : int64; -- kernel : string; -- priv: build_spec; --} -- --type build_state = --{ -- store_port : int; -- store_mfn : int64; -- console_port : int; -- console_mfn : int64; --} -- --type domid = int -- --type disk_phystype = -- | PHYSTYPE_QCOW -- | PHYSTYPE_QCOW2 -- | PHYSTYPE_VHD -- | PHYSTYPE_AIO -- | PHYSTYPE_FILE -- | PHYSTYPE_PHY -- --type disk_info = --{ -- backend_domid : domid; -- physpath : string; -- phystype : disk_phystype; -- virtpath : string; -- unpluggable : bool; -- readwrite : bool; -- is_cdrom : bool; --} -- --type nic_type = -- | NICTYPE_IOEMU -- | NICTYPE_VIF -- --type nic_info = --{ -- backend_domid : domid; -- devid : int; -- mtu : int; -- model : string; -- mac : int array; -- bridge : string; -- ifname : string; -- script : string; -- nictype : nic_type; --} -- --type console_type = -- | CONSOLETYPE_XENCONSOLED -- | CONSOLETYPE_IOEMU -- --type console_info = --{ -- backend_domid : domid; -- devid : int; -- consoletype : console_type; --} -- --type vkb_info = --{ -- backend_domid : domid; -- devid : int; --} -- --type vfb_info = --{ -- backend_domid : domid; -- devid : int; -- vnc : bool; -- vnclisten : string; -- vncpasswd : string; -- vncdisplay : int; -- vncunused : bool; -- keymap : string; -- sdl : bool; -- opengl : bool; -- display : string; -- xauthority : string; --} -- --type pci_info = --{ -- v : int; (* domain * bus * dev * func multiplexed *) -- domain : int; -- vdevfn : int; -- msitranslate : bool; -- power_mgmt : bool; --} -- --type physinfo = --{ -- threads_per_core: int; -- cores_per_socket: int; -- max_cpu_id: int; -- nr_cpus: int; -- cpu_khz: int; -- total_pages: int64; -- free_pages: int64; -- scrub_pages: int64; -- nr_nodes: int; -- hwcap: int32 array; -- physcap: int32; --} -- --type sched_credit = --{ -- weight: int; -- cap: int; --} -- --external domain_make : create_info -> domid = "stub_xl_domain_make" --external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build" -- --external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add" --external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove" -- --external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add" --external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove" -- --external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add" -- --external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add" --external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown" --external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown" -- --external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add" --external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown" --external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown" -- --external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add" --external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove" --external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown" -- --type button = -- | Button_Power -- | Button_Sleep -- --external button_press : domid -> button -> unit = "stub_xl_button_press" --external physinfo : unit -> physinfo = "stub_xl_physinfo" -- --external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get" --external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set" -- --external send_trigger : domid -> string -> int -> unit = "stub_xl_send_trigger" --external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" --external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys" -- --let _ = Callback.register_exception "xl.error" (Error "register_callback") ---- a/tools/ocaml/libs/xl/xl.mli -+++ /dev/null -@@ -1,211 +0,0 @@ --(* -- * Copyright (C) 2009-2010 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- *) -- --exception Error of string -- --type create_info = --{ -- hvm : bool; -- hap : bool; -- oos : bool; -- ssidref : int32; -- name : string; -- uuid : int array; -- xsdata : (string * string) list; -- platformdata : (string * string) list; -- poolid : int32; -- poolname : string; --} -- --type build_pv_info = --{ -- slack_memkb : int64; -- cmdline : string; -- ramdisk : string; -- features : string; --} -- --type build_hvm_info = --{ -- pae : bool; -- apic : bool; -- acpi : bool; -- nx : bool; -- viridian : bool; -- timeoffset : string; -- timer_mode : int; -- hpet : int; -- vpt_align : int; --} -- --type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info -- --type build_info = --{ -- max_vcpus : int; -- cur_vcpus : int; -- max_memkb : int64; -- target_memkb : int64; -- video_memkb : int64; -- shadow_memkb : int64; -- kernel : string; -- priv: build_spec; --} -- --type build_state = --{ -- store_port : int; -- store_mfn : int64; -- console_port : int; -- console_mfn : int64; --} -- --type domid = int -- --type disk_phystype = -- | PHYSTYPE_QCOW -- | PHYSTYPE_QCOW2 -- | PHYSTYPE_VHD -- | PHYSTYPE_AIO -- | PHYSTYPE_FILE -- | PHYSTYPE_PHY -- --type disk_info = --{ -- backend_domid : domid; -- physpath : string; -- phystype : disk_phystype; -- virtpath : string; -- unpluggable : bool; -- readwrite : bool; -- is_cdrom : bool; --} -- --type nic_type = -- | NICTYPE_IOEMU -- | NICTYPE_VIF -- --type nic_info = --{ -- backend_domid : domid; -- devid : int; -- mtu : int; -- model : string; -- mac : int array; -- bridge : string; -- ifname : string; -- script : string; -- nictype : nic_type; --} -- --type console_type = -- | CONSOLETYPE_XENCONSOLED -- | CONSOLETYPE_IOEMU -- --type console_info = --{ -- backend_domid : domid; -- devid : int; -- consoletype : console_type; --} -- --type vkb_info = --{ -- backend_domid : domid; -- devid : int; --} -- --type vfb_info = --{ -- backend_domid : domid; -- devid : int; -- vnc : bool; -- vnclisten : string; -- vncpasswd : string; -- vncdisplay : int; -- vncunused : bool; -- keymap : string; -- sdl : bool; -- opengl : bool; -- display : string; -- xauthority : string; --} -- --type pci_info = --{ -- v : int; (* domain * bus * dev * func multiplexed *) -- domain : int; -- vdevfn : int; -- msitranslate : bool; -- power_mgmt : bool; --} -- --type physinfo = --{ -- threads_per_core: int; -- cores_per_socket: int; -- max_cpu_id: int; -- nr_cpus: int; -- cpu_khz: int; -- total_pages: int64; -- free_pages: int64; -- scrub_pages: int64; -- nr_nodes: int; -- hwcap: int32 array; -- physcap: int32; --} -- --type sched_credit = --{ -- weight: int; -- cap: int; --} -- --external domain_make : create_info -> domid = "stub_xl_domain_make" --external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build" -- --external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add" --external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove" -- --external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add" --external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove" -- --external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add" -- --external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add" --external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown" --external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown" -- --external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add" --external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown" --external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown" -- --external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add" --external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove" --external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown" -- --type button = -- | Button_Power -- | Button_Sleep -- --external button_press : domid -> button -> unit = "stub_xl_button_press" --external physinfo : unit -> physinfo = "stub_xl_physinfo" -- --external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get" --external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set" -- --external send_trigger : domid -> string -> int -> unit = "stub_xl_send_trigger" --external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" --external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys" ---- /dev/null -+++ b/tools/ocaml/libs/xl/xenlight.ml -@@ -0,0 +1,213 @@ -+(* -+ * Copyright (C) 2009-2010 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ *) -+ -+exception Error of string -+ -+type create_info = -+{ -+ hvm : bool; -+ hap : bool; -+ oos : bool; -+ ssidref : int32; -+ name : string; -+ uuid : int array; -+ xsdata : (string * string) list; -+ platformdata : (string * string) list; -+ poolid : int32; -+ poolname : string; -+} -+ -+type build_pv_info = -+{ -+ slack_memkb : int64; -+ cmdline : string; -+ ramdisk : string; -+ features : string; -+} -+ -+type build_hvm_info = -+{ -+ pae : bool; -+ apic : bool; -+ acpi : bool; -+ nx : bool; -+ viridian : bool; -+ timeoffset : string; -+ timer_mode : int; -+ hpet : int; -+ vpt_align : int; -+} -+ -+type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info -+ -+type build_info = -+{ -+ max_vcpus : int; -+ cur_vcpus : int; -+ max_memkb : int64; -+ target_memkb : int64; -+ video_memkb : int64; -+ shadow_memkb : int64; -+ kernel : string; -+ priv: build_spec; -+} -+ -+type build_state = -+{ -+ store_port : int; -+ store_mfn : int64; -+ console_port : int; -+ console_mfn : int64; -+} -+ -+type domid = int -+ -+type disk_phystype = -+ | PHYSTYPE_QCOW -+ | PHYSTYPE_QCOW2 -+ | PHYSTYPE_VHD -+ | PHYSTYPE_AIO -+ | PHYSTYPE_FILE -+ | PHYSTYPE_PHY -+ -+type disk_info = -+{ -+ backend_domid : domid; -+ physpath : string; -+ phystype : disk_phystype; -+ virtpath : string; -+ unpluggable : bool; -+ readwrite : bool; -+ is_cdrom : bool; -+} -+ -+type nic_type = -+ | NICTYPE_IOEMU -+ | NICTYPE_VIF -+ -+type nic_info = -+{ -+ backend_domid : domid; -+ devid : int; -+ mtu : int; -+ model : string; -+ mac : int array; -+ bridge : string; -+ ifname : string; -+ script : string; -+ nictype : nic_type; -+} -+ -+type console_type = -+ | CONSOLETYPE_XENCONSOLED -+ | CONSOLETYPE_IOEMU -+ -+type console_info = -+{ -+ backend_domid : domid; -+ devid : int; -+ consoletype : console_type; -+} -+ -+type vkb_info = -+{ -+ backend_domid : domid; -+ devid : int; -+} -+ -+type vfb_info = -+{ -+ backend_domid : domid; -+ devid : int; -+ vnc : bool; -+ vnclisten : string; -+ vncpasswd : string; -+ vncdisplay : int; -+ vncunused : bool; -+ keymap : string; -+ sdl : bool; -+ opengl : bool; -+ display : string; -+ xauthority : string; -+} -+ -+type pci_info = -+{ -+ v : int; (* domain * bus * dev * func multiplexed *) -+ domain : int; -+ vdevfn : int; -+ msitranslate : bool; -+ power_mgmt : bool; -+} -+ -+type physinfo = -+{ -+ threads_per_core: int; -+ cores_per_socket: int; -+ max_cpu_id: int; -+ nr_cpus: int; -+ cpu_khz: int; -+ total_pages: int64; -+ free_pages: int64; -+ scrub_pages: int64; -+ nr_nodes: int; -+ hwcap: int32 array; -+ physcap: int32; -+} -+ -+type sched_credit = -+{ -+ weight: int; -+ cap: int; -+} -+ -+external domain_make : create_info -> domid = "stub_xl_domain_make" -+external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build" -+ -+external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add" -+external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove" -+ -+external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add" -+external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove" -+ -+external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add" -+ -+external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add" -+external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown" -+external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown" -+ -+external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add" -+external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown" -+external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown" -+ -+external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add" -+external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove" -+external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown" -+ -+type button = -+ | Button_Power -+ | Button_Sleep -+ -+external button_press : domid -> button -> unit = "stub_xl_button_press" -+external physinfo : unit -> physinfo = "stub_xl_physinfo" -+ -+external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get" -+external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set" -+ -+external send_trigger : domid -> string -> int -> unit = "stub_xl_send_trigger" -+external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" -+external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys" -+ -+let _ = Callback.register_exception "xl.error" (Error "register_callback") ---- /dev/null -+++ b/tools/ocaml/libs/xl/xenlight.mli -@@ -0,0 +1,211 @@ -+(* -+ * Copyright (C) 2009-2010 Citrix Ltd. -+ * Author Vincent Hanquez -+ * -+ * 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. -+ *) -+ -+exception Error of string -+ -+type create_info = -+{ -+ hvm : bool; -+ hap : bool; -+ oos : bool; -+ ssidref : int32; -+ name : string; -+ uuid : int array; -+ xsdata : (string * string) list; -+ platformdata : (string * string) list; -+ poolid : int32; -+ poolname : string; -+} -+ -+type build_pv_info = -+{ -+ slack_memkb : int64; -+ cmdline : string; -+ ramdisk : string; -+ features : string; -+} -+ -+type build_hvm_info = -+{ -+ pae : bool; -+ apic : bool; -+ acpi : bool; -+ nx : bool; -+ viridian : bool; -+ timeoffset : string; -+ timer_mode : int; -+ hpet : int; -+ vpt_align : int; -+} -+ -+type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info -+ -+type build_info = -+{ -+ max_vcpus : int; -+ cur_vcpus : int; -+ max_memkb : int64; -+ target_memkb : int64; -+ video_memkb : int64; -+ shadow_memkb : int64; -+ kernel : string; -+ priv: build_spec; -+} -+ -+type build_state = -+{ -+ store_port : int; -+ store_mfn : int64; -+ console_port : int; -+ console_mfn : int64; -+} -+ -+type domid = int -+ -+type disk_phystype = -+ | PHYSTYPE_QCOW -+ | PHYSTYPE_QCOW2 -+ | PHYSTYPE_VHD -+ | PHYSTYPE_AIO -+ | PHYSTYPE_FILE -+ | PHYSTYPE_PHY -+ -+type disk_info = -+{ -+ backend_domid : domid; -+ physpath : string; -+ phystype : disk_phystype; -+ virtpath : string; -+ unpluggable : bool; -+ readwrite : bool; -+ is_cdrom : bool; -+} -+ -+type nic_type = -+ | NICTYPE_IOEMU -+ | NICTYPE_VIF -+ -+type nic_info = -+{ -+ backend_domid : domid; -+ devid : int; -+ mtu : int; -+ model : string; -+ mac : int array; -+ bridge : string; -+ ifname : string; -+ script : string; -+ nictype : nic_type; -+} -+ -+type console_type = -+ | CONSOLETYPE_XENCONSOLED -+ | CONSOLETYPE_IOEMU -+ -+type console_info = -+{ -+ backend_domid : domid; -+ devid : int; -+ consoletype : console_type; -+} -+ -+type vkb_info = -+{ -+ backend_domid : domid; -+ devid : int; -+} -+ -+type vfb_info = -+{ -+ backend_domid : domid; -+ devid : int; -+ vnc : bool; -+ vnclisten : string; -+ vncpasswd : string; -+ vncdisplay : int; -+ vncunused : bool; -+ keymap : string; -+ sdl : bool; -+ opengl : bool; -+ display : string; -+ xauthority : string; -+} -+ -+type pci_info = -+{ -+ v : int; (* domain * bus * dev * func multiplexed *) -+ domain : int; -+ vdevfn : int; -+ msitranslate : bool; -+ power_mgmt : bool; -+} -+ -+type physinfo = -+{ -+ threads_per_core: int; -+ cores_per_socket: int; -+ max_cpu_id: int; -+ nr_cpus: int; -+ cpu_khz: int; -+ total_pages: int64; -+ free_pages: int64; -+ scrub_pages: int64; -+ nr_nodes: int; -+ hwcap: int32 array; -+ physcap: int32; -+} -+ -+type sched_credit = -+{ -+ weight: int; -+ cap: int; -+} -+ -+external domain_make : create_info -> domid = "stub_xl_domain_make" -+external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build" -+ -+external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add" -+external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove" -+ -+external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add" -+external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove" -+ -+external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add" -+ -+external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add" -+external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown" -+external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown" -+ -+external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add" -+external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown" -+external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown" -+ -+external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add" -+external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove" -+external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown" -+ -+type button = -+ | Button_Power -+ | Button_Sleep -+ -+external button_press : domid -> button -> unit = "stub_xl_button_press" -+external physinfo : unit -> physinfo = "stub_xl_physinfo" -+ -+external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get" -+external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set" -+ -+external send_trigger : domid -> string -> int -> unit = "stub_xl_send_trigger" -+external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" -+external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys" ---- a/tools/ocaml/libs/xl/META.in -+++ b/tools/ocaml/libs/xl/META.in -@@ -1,4 +1,4 @@ - version = "@VERSION@" - description = "Xen Toolstack Library" --archive(byte) = "xl.cma" --archive(native) = "xl.cmxa" -+archive(byte) = "xenlight.cma" -+archive(native) = "xenlight.cmxa" diff --git a/upstream-23937:5173834e8476 b/upstream-23937:5173834e8476 deleted file mode 100644 index f91dbaf..0000000 --- a/upstream-23937:5173834e8476 +++ /dev/null @@ -1,20 +0,0 @@ -# HG changeset patch -# User Jon Ludlam -# Date 1318261088 -3600 -# Node ID 5173834e8476074afceb5c0124126e74a3954e97 -# Parent cdb34816a40a2dd3aaf324f7dcba83a122cf9146 -tools/ocaml: Add a missing dependency to the xenctrl ocaml package - -Signed-off-by: Jon Ludlam -Acked-by: Ian Campbell -Committed-by: Ian Jackson - ---- a/tools/ocaml/libs/xc/META.in -+++ b/tools/ocaml/libs/xc/META.in -@@ -1,5 +1,5 @@ - version = "@VERSION@" - description = "Xen Control Interface" --requires = "xenmmap,uuid" -+requires = "unix,xenmmap,uuid" - archive(byte) = "xenctrl.cma" - archive(native) = "xenctrl.cmxa" diff --git a/upstream-23938:fa04fbd56521-rework b/upstream-23938:fa04fbd56521-rework deleted file mode 100644 index 72f0e64..0000000 --- a/upstream-23938:fa04fbd56521-rework +++ /dev/null @@ -1,321 +0,0 @@ -# HG changeset patch -# User Jon Ludlam -# Date 1317295879 -3600 -# Node ID 6c87e9dc5331096e8bfbad60a4f560cae05c4034 -# Parent c5df5f625ee2a0339b2a6785f99a5a0f9727f836 -[OCAML] Remove the uuid library - -This patch has the same effect as xen-unstable.hg c/s -23938:fa04fbd56521 - -The library was only minimally used, and was really rather redundant. - -Signed-off-by: Zheng Li -Acked-by: Jon Ludlam - ---- a/tools/ocaml/libs/Makefile -+++ b/tools/ocaml/libs/Makefile -@@ -2,7 +2,7 @@ - include $(XEN_ROOT)/tools/Rules.mk - - SUBDIRS= \ -- uuid mmap \ -+ mmap \ - log xc eventchn \ - xb xs xl - ---- a/tools/ocaml/libs/uuid/META.in -+++ /dev/null -@@ -1,4 +0,0 @@ --version = "@VERSION@" --description = "Uuid - universal identifer" --archive(byte) = "uuid.cma" --archive(native) = "uuid.cmxa" ---- a/tools/ocaml/libs/uuid/uuid.ml -+++ /dev/null -@@ -1,100 +0,0 @@ --(* -- * Copyright (C) 2006-2010 Citrix Systems Inc. -- * Author Vincent Hanquez -- * -- * 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. -- *) -- --(* Internally, a UUID is simply a string. *) --type 'a t = string -- --type cookie = string -- --let of_string s = s --let to_string s = s -- --let null = "" -- --(* deprecated: we don't need to duplicate the uuid prefix/suffix *) --let uuid_of_string = of_string --let string_of_uuid = to_string -- --let string_of_cookie s = s -- --let cookie_of_string s = s -- --let dev_random = "/dev/random" --let dev_urandom = "/dev/urandom" -- --let rnd_array n = -- let fstbyte i = 0xff land i in -- let sndbyte i = fstbyte (i lsr 8) in -- let thdbyte i = sndbyte (i lsr 8) in -- let rec rnd_list n acc = match n with -- | 0 -> acc -- | 1 -> -- let b = fstbyte (Random.bits ()) in -- b :: acc -- | 2 -> -- let r = Random.bits () in -- let b1 = fstbyte r in -- let b2 = sndbyte r in -- b1 :: b2 :: acc -- | n -> -- let r = Random.bits () in -- let b1 = fstbyte r in -- let b2 = sndbyte r in -- let b3 = thdbyte r in -- rnd_list (n - 3) (b1 :: b2 :: b3 :: acc) -- in -- Array.of_list (rnd_list n []) -- --let read_array dev n = -- let ic = open_in_bin dev in -- try -- let result = Array.init n (fun _ -> input_byte ic) in -- close_in ic; -- result -- with e -> -- close_in ic; -- raise e -- --let uuid_of_int_array uuid = -- Printf.sprintf "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" -- uuid.(0) uuid.(1) uuid.(2) uuid.(3) uuid.(4) uuid.(5) -- uuid.(6) uuid.(7) uuid.(8) uuid.(9) uuid.(10) uuid.(11) -- uuid.(12) uuid.(13) uuid.(14) uuid.(15) -- --let make_uuid_prng () = uuid_of_int_array (rnd_array 16) --let make_uuid_urnd () = uuid_of_int_array (read_array dev_urandom 16) --let make_uuid_rnd () = uuid_of_int_array (read_array dev_random 16) --let make_uuid = make_uuid_urnd -- --let make_cookie() = -- let bytes = Array.to_list (read_array dev_urandom 64) in -- String.concat "" (List.map (Printf.sprintf "%1x") bytes) -- --let int_array_of_uuid s = -- try -- let l = ref [] in -- Scanf.sscanf s "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" -- (fun a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 -> -- l := [ a0; a1; a2; a3; a4; a5; a6; a7; a8; a9; -- a10; a11; a12; a13; a14; a15; ]); -- Array.of_list !l -- with _ -> invalid_arg "Uuid.int_array_of_uuid" -- --let is_uuid str = -- try -- Scanf.sscanf str -- "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" -- (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> true) -- with _ -> false ---- a/tools/ocaml/libs/uuid/uuid.mli -+++ /dev/null -@@ -1,67 +0,0 @@ --(* -- * Copyright (C) 2006-2010 Citrix Systems Inc. -- * Author Vincent Hanquez -- * -- * 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-safe UUIDs. -- Probably need to refactor this; UUIDs are used in two places: -- + to uniquely name things across the cluster -- + as secure session IDs -- -- There is the additional constraint that current Xen tools use -- a particular format of UUID (the 16 byte variety generated by fresh ()) -- -- Also, cookies aren't UUIDs and should be put somewhere else. --*) -- --(** A 128-bit UUID. Using phantom types ('a) to achieve the requires type-safety. *) --type 'a t -- --(** Create a fresh UUID *) --val make_uuid : unit -> 'a t --val make_uuid_prng : unit -> 'a t --val make_uuid_urnd : unit -> 'a t --val make_uuid_rnd : unit -> 'a t -- --(** Create a UUID from a string. *) --val of_string : string -> 'a t -- --(** Marshal a UUID to a string. *) --val to_string : 'a t -> string -- --(** A null UUID, as if such a thing actually existed. It turns out to be -- * useful though. *) --val null : 'a t -- --(** Deprecated alias for {! Uuid.of_string} *) --val uuid_of_string : string -> 'a t -- --(** Deprecated alias for {! Uuid.to_string} *) --val string_of_uuid : 'a t -> string -- --(** Convert an array to a UUID. *) --val uuid_of_int_array : int array -> 'a t -- --(** Convert a UUID to an array. *) --val int_array_of_uuid : 'a t -> int array -- --(** Check whether a string is a UUID. *) --val is_uuid : string -> bool -- --(** A 512-bit cookie. *) --type cookie -- --val make_cookie : unit -> cookie -- --val cookie_of_string : string -> cookie -- --val string_of_cookie : cookie -> string ---- a/tools/ocaml/libs/xc/META.in -+++ b/tools/ocaml/libs/xc/META.in -@@ -1,5 +1,5 @@ - version = "@VERSION@" - description = "Xen Control Interface" --requires = "unix,xenmmap,uuid" -+requires = "unix,xenmmap" - archive(byte) = "xenctrl.cma" - archive(native) = "xenctrl.cmxa" ---- a/tools/ocaml/libs/xc/Makefile -+++ b/tools/ocaml/libs/xc/Makefile -@@ -3,7 +3,7 @@ - include $(TOPLEVEL)/common.make - - CFLAGS += -I../mmap -I./ -I$(XEN_ROOT)/tools/libxc --OCAMLINCLUDE += -I ../mmap -I ../uuid -I $(XEN_ROOT)/tools/libxc -+OCAMLINCLUDE += -I ../mmap -I $(XEN_ROOT)/tools/libxc - - OBJS = xenctrl - INTF = xenctrl.cmi ---- a/tools/ocaml/libs/xc/xenctrl.ml -+++ b/tools/ocaml/libs/xc/xenctrl.ml -@@ -118,14 +118,23 @@ - external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid - = "stub_xc_domain_create" - -+let int_array_of_uuid_string s = -+ try -+ Scanf.sscanf s -+ "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" -+ (fun a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 -> -+ [| a0; a1; a2; a3; a4; a5; a6; a7; -+ a8; a9; a10; a11; a12; a13; a14; a15 |]) -+ with _ -> invalid_arg ("Xc.int_array_of_uuid_string: " ^ s) -+ - let domain_create handle n flags uuid = -- _domain_create handle n flags (Uuid.int_array_of_uuid uuid) -+ _domain_create handle n flags (int_array_of_uuid_string uuid) - - external _domain_sethandle: handle -> domid -> int array -> unit - = "stub_xc_domain_sethandle" - - let domain_sethandle handle n uuid = -- _domain_sethandle handle n (Uuid.int_array_of_uuid uuid) -+ _domain_sethandle handle n (int_array_of_uuid_string uuid) - - external domain_max_vcpus: handle -> domid -> int -> unit - = "stub_xc_domain_max_vcpus" ---- a/tools/ocaml/libs/xc/xenctrl.mli -+++ b/tools/ocaml/libs/xc/xenctrl.mli -@@ -74,12 +74,8 @@ - external is_fake : unit -> bool = "stub_xc_interface_is_fake" - external interface_close : handle -> unit = "stub_xc_interface_close" - val with_intf : (handle -> 'a) -> 'a --external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid -- = "stub_xc_domain_create" --val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t -> domid --external _domain_sethandle : handle -> domid -> int array -> unit -- = "stub_xc_domain_sethandle" --val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit -+val domain_create : handle -> int32 -> domain_create_flag list -> string -> domid -+val domain_sethandle : handle -> domid -> string -> unit - external domain_max_vcpus : handle -> domid -> int -> unit - = "stub_xc_domain_max_vcpus" - external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause" ---- a/tools/ocaml/xenstored/Makefile -+++ b/tools/ocaml/xenstored/Makefile -@@ -5,7 +5,6 @@ - OCAMLINCLUDE += \ - -I $(OCAML_TOPLEVEL)/libs/log \ - -I $(OCAML_TOPLEVEL)/libs/xb \ -- -I $(OCAML_TOPLEVEL)/libs/uuid \ - -I $(OCAML_TOPLEVEL)/libs/mmap \ - -I $(OCAML_TOPLEVEL)/libs/xc \ - -I $(OCAML_TOPLEVEL)/libs/eventchn -@@ -34,7 +33,6 @@ - INTF = symbol.cmi trie.cmi - XENSTOREDLIBS = \ - unix.cmxa \ -- $(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \ ---- a/tools/ocaml/libs/uuid/Makefile -+++ /dev/null -@@ -1,29 +0,0 @@ --TOPLEVEL=$(CURDIR)/../.. --XEN_ROOT=$(TOPLEVEL)/../.. --include $(TOPLEVEL)/common.make -- --OBJS = uuid --INTF = $(foreach obj, $(OBJS),$(obj).cmi) --LIBS = uuid.cma uuid.cmxa -- --all: $(INTF) $(LIBS) $(PROGRAMS) -- --bins: $(PROGRAMS) -- --libs: $(LIBS) -- --uuid_OBJS = $(OBJS) --OCAML_NOC_LIBRARY = uuid -- --.PHONY: install --install: $(LIBS) META -- mkdir -p $(OCAMLDESTDIR) -- ocamlfind remove -destdir $(OCAMLDESTDIR) uuid -- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore uuid META $(INTF) $(LIBS) *.a *.cmx -- --.PHONY: uninstall --uninstall: -- ocamlfind remove -destdir $(OCAMLDESTDIR) uuid -- --include $(TOPLEVEL)/Makefile.rules -- diff --git a/upstream-23939:51288f69523f-rework b/upstream-23939:51288f69523f-rework deleted file mode 100644 index 30fcb1c..0000000 --- a/upstream-23939:51288f69523f-rework +++ /dev/null @@ -1,1509 +0,0 @@ -# HG changeset patch -# User Jon Ludlam -# Date 1317300078 -3600 -# Node ID f628a2174cd0289400e2fe476cc3177fbcba3c8d -# Parent 42cdb34ec175602fa2d8f0f65e44c4eb3a086496 -[OCAML] Remove log library from tools/ocaml/libs - -This patch has the same effect as xen-unstable.hg c/s 23939:51288f69523f - -The only user was oxenstored, which has had the relevant bits -merged in. - -Signed-off-by: Zheng Li -Acked-by: Jon Ludlam - ---- a/tools/ocaml/libs/Makefile -+++ b/tools/ocaml/libs/Makefile -@@ -3,7 +3,7 @@ - - SUBDIRS= \ - mmap \ -- log xc eventchn \ -+ xc eventchn \ - xb xs xl - - .PHONY: all ---- a/tools/ocaml/libs/log/META.in -+++ /dev/null -@@ -1,5 +0,0 @@ --version = "@VERSION@" --description = "Log - logging library" --requires = "unix" --archive(byte) = "log.cma" --archive(native) = "log.cmxa" ---- a/tools/ocaml/libs/log/log.ml -+++ /dev/null -@@ -1,258 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- *) -- --open Printf -- --exception Unknown_level of string -- --type stream_type = Stderr | Stdout | File of string -- --type stream_log = { -- ty : stream_type; -- channel : out_channel option ref; --} -- --type level = Debug | Info | Warn | Error -- --type output = -- | Stream of stream_log -- | String of string list ref -- | Syslog of string -- | Nil -- --let int_of_level l = -- match l with Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3 -- --let string_of_level l = -- match l with Debug -> "debug" | Info -> "info" -- | Warn -> "warn" | Error -> "error" -- --let level_of_string s = -- match s with -- | "debug" -> Debug -- | "info" -> Info -- | "warn" -> Warn -- | "error" -> Error -- | _ -> raise (Unknown_level s) -- --let mkdir_safe dir perm = -- try Unix.mkdir dir perm with _ -> () -- --let mkdir_rec dir perm = -- let rec p_mkdir dir = -- let p_name = Filename.dirname dir in -- if p_name = "/" || p_name = "." then -- () -- else ( -- p_mkdir p_name; -- mkdir_safe dir perm -- ) in -- p_mkdir dir -- --type t = { output: output; mutable level: level; } -- --let make output level = { output = output; level = level; } -- --let make_stream ty channel = -- Stream {ty=ty; channel=ref channel; } -- --(** open a syslog logger *) --let opensyslog k level = -- make (Syslog k) level -- --(** open a stderr logger *) --let openerr level = -- if (Unix.stat "/dev/stderr").Unix.st_kind <> Unix.S_CHR then -- failwith "/dev/stderr is not a valid character device"; -- make (make_stream Stderr (Some (open_out "/dev/stderr"))) level -- --let openout level = -- if (Unix.stat "/dev/stdout").Unix.st_kind <> Unix.S_CHR then -- failwith "/dev/stdout is not a valid character device"; -- make (make_stream Stdout (Some (open_out "/dev/stdout"))) level -- -- --(** open a stream logger - returning the channel. *) --(* This needs to be separated from 'openfile' so we can reopen later *) --let doopenfile filename = -- if Filename.is_relative filename then -- None -- else ( -- try -- mkdir_rec (Filename.dirname filename) 0o700; -- Some (open_out_gen [ Open_append; Open_creat ] 0o600 filename) -- with _ -> None -- ) -- --(** open a stream logger - returning the output type *) --let openfile filename level = -- make (make_stream (File filename) (doopenfile filename)) level -- --(** open a nil logger *) --let opennil () = -- make Nil Error -- --(** open a string logger *) --let openstring level = -- make (String (ref [""])) level -- --(** try to reopen a logger *) --let reopen t = -- match t.output with -- | Nil -> t -- | Syslog k -> Syslog.close (); opensyslog k t.level -- | Stream s -> ( -- match (s.ty,!(s.channel)) with -- | (File filename, Some c) -> close_out c; s.channel := (try doopenfile filename with _ -> None); t -- | _ -> t) -- | String _ -> t -- --(** close a logger *) --let close t = -- match t.output with -- | Nil -> () -- | Syslog k -> Syslog.close (); -- | Stream s -> ( -- match !(s.channel) with -- | Some c -> close_out c; s.channel := None -- | None -> ()) -- | String _ -> () -- --(** create a string representating the parameters of the logger *) --let string_of_logger t = -- match t.output with -- | Nil -> "nil" -- | Syslog k -> sprintf "syslog:%s" k -- | String _ -> "string" -- | Stream s -> -- begin -- match s.ty with -- | File f -> sprintf "file:%s" f -- | Stderr -> "stderr" -- | Stdout -> "stdout" -- end -- --(** parse a string to a logger *) --let logger_of_string s : t = -- match s with -- | "nil" -> opennil () -- | "stderr" -> openerr Debug -- | "stdout" -> openout Debug -- | "string" -> openstring Debug -- | _ -> -- let split_in_2 s = -- try -- let i = String.index s ':' in -- String.sub s 0 (i), -- String.sub s (i + 1) (String.length s - i - 1) -- with _ -> -- failwith "logger format error: expecting string:string" -- in -- let k, s = split_in_2 s in -- match k with -- | "syslog" -> opensyslog s Debug -- | "file" -> openfile s Debug -- | _ -> failwith "unknown logger type" -- --let validate s = -- match s with -- | "nil" -> () -- | "stderr" -> () -- | "stdout" -> () -- | "string" -> () -- | _ -> -- let split_in_2 s = -- try -- let i = String.index s ':' in -- String.sub s 0 (i), -- String.sub s (i + 1) (String.length s - i - 1) -- with _ -> -- failwith "logger format error: expecting string:string" -- in -- let k, s = split_in_2 s in -- match k with -- | "syslog" -> () -- | "file" -> ( -- try -- let st = Unix.stat s in -- if st.Unix.st_kind <> Unix.S_REG then -- failwith "logger file is a directory"; -- () -- with Unix.Unix_error (Unix.ENOENT, _, _) -> () -- ) -- | _ -> failwith "unknown logger" -- --(** change a logger level to level *) --let set t level = t.level <- level -- --let gettimestring () = -- let time = Unix.gettimeofday () in -- let tm = Unix.localtime time in -- let msec = time -. (floor time) in -- sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d|" (1900 + tm.Unix.tm_year) -- (tm.Unix.tm_mon + 1) tm.Unix.tm_mday -- tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec -- (int_of_float (1000.0 *. msec)) -- --(*let extra_hook = ref (fun x -> x)*) -- --let output t ?(key="") ?(extra="") priority (message: string) = -- let construct_string withtime = -- (*let key = if key = "" then [] else [ key ] in -- let extra = if extra = "" then [] else [ extra ] in -- let items = -- (if withtime then [ gettimestring () ] else []) -- @ [ sprintf "%5s" (string_of_level priority) ] @ extra @ key @ [ message ] in --(* let items = !extra_hook items in*) -- String.concat " " items*) -- Printf.sprintf "[%s%s|%s] %s" -- (if withtime then gettimestring () else "") (string_of_level priority) extra message -- in -- (* Keep track of how much we write out to streams, so that we can *) -- (* log-rotate at appropriate times *) -- let write_to_stream stream = -- let string = (construct_string true) in -- try -- fprintf stream "%s\n%!" string -- with _ -> () (* Trap exception when we fail to write log *) -- in -- -- if String.length message > 0 then -- match t.output with -- | Syslog k -> -- let sys_prio = match priority with -- | Debug -> Syslog.Debug -- | Info -> Syslog.Info -- | Warn -> Syslog.Warning -- | Error -> Syslog.Err in -- Syslog.log Syslog.Daemon sys_prio ((construct_string false) ^ "\n") -- | Stream s -> ( -- match !(s.channel) with -- | Some c -> write_to_stream c -- | None -> ()) -- | Nil -> () -- | String s -> (s := (construct_string true)::!s) -- --let log t level (fmt: ('a, unit, string, unit) format4): 'a = -- let b = (int_of_level t.level) <= (int_of_level level) in -- (* ksprintf is the preferred name for kprintf, but the former -- * is not available in OCaml 3.08.3 *) -- Printf.kprintf (if b then output t level else (fun _ -> ())) fmt -- --let debug t (fmt: ('a , unit, string, unit) format4) = log t Debug fmt --let info t (fmt: ('a , unit, string, unit) format4) = log t Info fmt --let warn t (fmt: ('a , unit, string, unit) format4) = log t Warn fmt --let error t (fmt: ('a , unit, string, unit) format4) = log t Error fmt ---- a/tools/ocaml/libs/log/log.mli -+++ /dev/null -@@ -1,55 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- *) -- --exception Unknown_level of string --type level = Debug | Info | Warn | Error -- --type stream_type = Stderr | Stdout | File of string --type stream_log = { -- ty : stream_type; -- channel : out_channel option ref; --} --type output = -- Stream of stream_log -- | String of string list ref -- | Syslog of string -- | Nil --val int_of_level : level -> int --val string_of_level : level -> string --val level_of_string : string -> level --val mkdir_safe : string -> Unix.file_perm -> unit --val mkdir_rec : string -> Unix.file_perm -> unit --type t = { output : output; mutable level : level; } --val make : output -> level -> t --val opensyslog : string -> level -> t --val openerr : level -> t --val openout : level -> t --val openfile : string -> level -> t --val opennil : unit -> t --val openstring : level -> t --val reopen : t -> t --val close : t -> unit --val string_of_logger : t -> string --val logger_of_string : string -> t --val validate : string -> unit --val set : t -> level -> unit --val gettimestring : unit -> string --val output : t -> ?key:string -> ?extra:string -> level -> string -> unit --val log : t -> level -> ('a, unit, string, unit) format4 -> 'a --val debug : t -> ('a, unit, string, unit) format4 -> 'a --val info : t -> ('a, unit, string, unit) format4 -> 'a --val warn : t -> ('a, unit, string, unit) format4 -> 'a --val error : t -> ('a, unit, string, unit) format4 -> 'a ---- a/tools/ocaml/libs/log/logs.ml -+++ /dev/null -@@ -1,197 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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 keylogger = --{ -- mutable debug: string list; -- mutable info: string list; -- mutable warn: string list; -- mutable error: string list; -- no_default: bool; --} -- --(* map all logger strings into a logger *) --let __all_loggers = Hashtbl.create 10 -- --(* default logger that everything that doesn't have a key in __lop_mapping get send *) --let __default_logger = { debug = []; info = []; warn = []; error = []; no_default = false } -- --(* -- * This describe the mapping between a name to a keylogger. -- * a keylogger contains a list of logger string per level of debugging. -- * Example: "xenops", debug -> [ "stderr"; "/var/log/xensource.log" ] -- * "xapi", error -> [] -- * "xapi", debug -> [ "/var/log/xensource.log" ] -- * "xenops", info -> [ "syslog" ] -- *) --let __log_mapping = Hashtbl.create 32 -- --let get_or_open logstring = -- if Hashtbl.mem __all_loggers logstring then -- Hashtbl.find __all_loggers logstring -- else -- let t = Log.logger_of_string logstring in -- Hashtbl.add __all_loggers logstring t; -- t -- --(** create a mapping entry for the key "name". -- * all log level of key "name" default to "logger" logger. -- * a sensible default is put "nil" as a logger and reopen a specific level to -- * the logger you want to. -- *) --let add key logger = -- let kl = { -- debug = logger; -- info = logger; -- warn = logger; -- error = logger; -- no_default = false; -- } in -- Hashtbl.add __log_mapping key kl -- --let get_by_level keylog level = -- match level with -- | Log.Debug -> keylog.debug -- | Log.Info -> keylog.info -- | Log.Warn -> keylog.warn -- | Log.Error -> keylog.error -- --let set_by_level keylog level logger = -- match level with -- | Log.Debug -> keylog.debug <- logger -- | Log.Info -> keylog.info <- logger -- | Log.Warn -> keylog.warn <- logger -- | Log.Error -> keylog.error <- logger -- --(** set a specific key|level to the logger "logger" *) --let set key level logger = -- if not (Hashtbl.mem __log_mapping key) then -- add key []; -- -- let keylog = Hashtbl.find __log_mapping key in -- set_by_level keylog level logger -- --(** set default logger *) --let set_default level logger = -- set_by_level __default_logger level logger -- --(** append a logger to the list *) --let append key level logger = -- if not (Hashtbl.mem __log_mapping key) then -- add key []; -- let keylog = Hashtbl.find __log_mapping key in -- let loggers = get_by_level keylog level in -- set_by_level keylog level (loggers @ [ logger ]) -- --(** append a logger to the default list *) --let append_default level logger = -- let loggers = get_by_level __default_logger level in -- set_by_level __default_logger level (loggers @ [ logger ]) -- --(** reopen all logger open *) --let reopen () = -- Hashtbl.iter (fun k v -> -- Hashtbl.replace __all_loggers k (Log.reopen v)) __all_loggers -- --(** reclaim close all logger open that are not use by any other keys *) --let reclaim () = -- let list_sort_uniq l = -- let oldprev = ref "" and prev = ref "" in -- List.fold_left (fun a k -> -- oldprev := !prev; -- prev := k; -- if k = !oldprev then a else k :: a) [] -- (List.sort compare l) -- in -- let flatten_keylogger v = -- list_sort_uniq (v.debug @ v.info @ v.warn @ v.error) in -- let oldkeys = Hashtbl.fold (fun k v a -> k :: a) __all_loggers [] in -- let usedkeys = Hashtbl.fold (fun k v a -> -- (flatten_keylogger v) @ a) -- __log_mapping (flatten_keylogger __default_logger) in -- let usedkeys = list_sort_uniq usedkeys in -- -- List.iter (fun k -> -- if not (List.mem k usedkeys) then ( -- begin try -- Log.close (Hashtbl.find __all_loggers k) -- with -- Not_found -> () -- end; -- Hashtbl.remove __all_loggers k -- )) oldkeys -- --(** clear a specific key|level *) --let clear key level = -- try -- let keylog = Hashtbl.find __log_mapping key in -- set_by_level keylog level []; -- reclaim () -- with Not_found -> -- () -- --(** clear a specific default level *) --let clear_default level = -- set_default level []; -- reclaim () -- --(** reset all the loggers to the specified logger *) --let reset_all logger = -- Hashtbl.clear __log_mapping; -- set_default Log.Debug logger; -- set_default Log.Warn logger; -- set_default Log.Error logger; -- set_default Log.Info logger; -- reclaim () -- --(** log a fmt message to the key|level logger specified in the log mapping. -- * if the logger doesn't exist, assume nil logger. -- *) --let log key level ?(extra="") (fmt: ('a, unit, string, unit) format4): 'a = -- let keylog = -- if Hashtbl.mem __log_mapping key then -- let keylog = Hashtbl.find __log_mapping key in -- if keylog.no_default = false && -- get_by_level keylog level = [] then -- __default_logger -- else -- keylog -- else -- __default_logger in -- let loggers = get_by_level keylog level in -- match loggers with -- | [] -> Printf.kprintf ignore fmt -- | _ -> -- let l = List.fold_left (fun acc logger -> -- try get_or_open logger :: acc -- with _ -> acc -- ) [] loggers in -- let l = List.rev l in -- -- (* ksprintf is the preferred name for kprintf, but the former -- * is not available in OCaml 3.08.3 *) -- Printf.kprintf (fun s -> -- List.iter (fun t -> Log.output t ~key ~extra level s) l) fmt -- --(* define some convenience functions *) --let debug t ?extra (fmt: ('a , unit, string, unit) format4) = -- log t Log.Debug ?extra fmt --let info t ?extra (fmt: ('a , unit, string, unit) format4) = -- log t Log.Info ?extra fmt --let warn t ?extra (fmt: ('a , unit, string, unit) format4) = -- log t Log.Warn ?extra fmt --let error t ?extra (fmt: ('a , unit, string, unit) format4) = -- log t Log.Error ?extra fmt ---- a/tools/ocaml/libs/log/logs.mli -+++ /dev/null -@@ -1,46 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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 keylogger = { -- mutable debug : string list; -- mutable info : string list; -- mutable warn : string list; -- mutable error : string list; -- no_default : bool; --} --val __all_loggers : (string, Log.t) Hashtbl.t --val __default_logger : keylogger --val __log_mapping : (string, keylogger) Hashtbl.t --val get_or_open : string -> Log.t --val add : string -> string list -> unit --val get_by_level : keylogger -> Log.level -> string list --val set_by_level : keylogger -> Log.level -> string list -> unit --val set : string -> Log.level -> string list -> unit --val set_default : Log.level -> string list -> unit --val append : string -> Log.level -> string -> unit --val append_default : Log.level -> string -> unit --val reopen : unit -> unit --val reclaim : unit -> unit --val clear : string -> Log.level -> unit --val clear_default : Log.level -> unit --val reset_all : string list -> unit --val log : -- string -> -- Log.level -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a --val debug : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a --val info : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a --val warn : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a --val error : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a ---- a/tools/ocaml/libs/log/syslog.ml -+++ /dev/null -@@ -1,26 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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 level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug --type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid --type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern -- | Local0 | Local1 | Local2 | Local3 -- | Local4 | Local5 | Local6 | Local7 -- | Lpr | Mail | News | Syslog | User | Uucp -- --(* external init : string -> options list -> facility -> unit = "stub_openlog" *) --external log : facility -> level -> string -> unit = "stub_syslog" --external close : unit -> unit = "stub_closelog" ---- a/tools/ocaml/libs/log/syslog_stubs.c -+++ /dev/null -@@ -1,75 +0,0 @@ --/* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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. -- */ -- --#include --#include --#include --#include --#include -- --static int __syslog_level_table[] = { -- LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING, -- LOG_NOTICE, LOG_INFO, LOG_DEBUG --}; -- --/* --static int __syslog_options_table[] = { -- LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID --}; --*/ -- --static int __syslog_facility_table[] = { -- LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN, -- LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3, -- LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7, -- LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP --}; -- --/* According to the openlog manpage the 'openlog' call may take a reference -- to the 'ident' string and keep it long-term. This means we cannot just pass in -- an ocaml string which is under the control of the GC. Since we aren't actually -- calling this function we can just comment it out for the time-being. */ --/* --value stub_openlog(value ident, value option, value facility) --{ -- CAMLparam3(ident, option, facility); -- int c_option; -- int c_facility; -- -- c_option = caml_convert_flag_list(option, __syslog_options_table); -- c_facility = __syslog_facility_table[Int_val(facility)]; -- openlog(String_val(ident), c_option, c_facility); -- CAMLreturn(Val_unit); --} --*/ -- --value stub_syslog(value facility, value level, value msg) --{ -- CAMLparam3(facility, level, msg); -- int c_facility; -- -- c_facility = __syslog_facility_table[Int_val(facility)] -- | __syslog_level_table[Int_val(level)]; -- syslog(c_facility, "%s", String_val(msg)); -- CAMLreturn(Val_unit); --} -- --value stub_closelog(value unit) --{ -- CAMLparam1(unit); -- closelog(); -- CAMLreturn(Val_unit); --} ---- a/tools/ocaml/xenstored/Makefile -+++ b/tools/ocaml/xenstored/Makefile -@@ -3,7 +3,6 @@ - include $(OCAML_TOPLEVEL)/common.make - - OCAMLINCLUDE += \ -- -I $(OCAML_TOPLEVEL)/libs/log \ - -I $(OCAML_TOPLEVEL)/libs/xb \ - -I $(OCAML_TOPLEVEL)/libs/mmap \ - -I $(OCAML_TOPLEVEL)/libs/xc \ -@@ -34,7 +33,6 @@ - XENSTOREDLIBS = \ - unix.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \ -- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xenbus.cmxa \ ---- a/tools/ocaml/xenstored/connection.ml -+++ b/tools/ocaml/xenstored/connection.ml -@@ -232,3 +232,8 @@ - Printf.fprintf chan "watch,%d,%s,%s\n" domid (Utils.hexify path) (Utils.hexify token) - ) (list_watches con); - | None -> () -+ -+let debug con = -+ let domid = get_domstr con in -+ let watches = List.map (fun (path, token) -> Printf.sprintf "watch %s: %s %s\n" domid path token) (list_watches con) in -+ String.concat "" watches ---- a/tools/ocaml/xenstored/connections.ml -+++ b/tools/ocaml/xenstored/connections.ml -@@ -15,7 +15,7 @@ - * GNU Lesser General Public License for more details. - *) - --let debug fmt = Logs.debug "general" fmt -+let debug fmt = Logging.debug "connections" fmt - - type t = { - mutable anonymous: Connection.t list; -@@ -165,3 +165,8 @@ - ); - (List.length cons.anonymous, !nb_ops_anon, !nb_watchs_anon, - Hashtbl.length cons.domains, !nb_ops_dom, !nb_watchs_dom) -+ -+let debug cons = -+ let anonymous = List.map Connection.debug cons.anonymous in -+ let domains = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.domains [] in -+ String.concat "" (domains @ anonymous) ---- a/tools/ocaml/xenstored/disk.ml -+++ b/tools/ocaml/xenstored/disk.ml -@@ -17,7 +17,7 @@ - let enable = ref false - let xs_daemon_database = "/var/run/xenstored/db" - --let error = Logs.error "general" -+let error fmt = Logging.error "disk" fmt - - (* unescape utils *) - exception Bad_escape ---- a/tools/ocaml/xenstored/domain.ml -+++ b/tools/ocaml/xenstored/domain.ml -@@ -16,7 +16,7 @@ - - open Printf - --let debug fmt = Logs.debug "general" fmt -+let debug fmt = Logging.debug "domain" fmt - - type t = - { ---- a/tools/ocaml/xenstored/domains.ml -+++ b/tools/ocaml/xenstored/domains.ml -@@ -14,6 +14,8 @@ - * GNU Lesser General Public License for more details. - *) - -+let debug fmt = Logging.debug "domains" fmt -+ - type domains = { - eventchn: Event.t; - table: (Xenctrl.domid, Domain.t) Hashtbl.t; -@@ -35,7 +37,7 @@ - try - let info = Xenctrl.domain_getinfo xc id in - if info.Xenctrl.shutdown || info.Xenctrl.dying then ( -- Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)" -+ debug "Domain %u died (dying=%b, shutdown %b -- code %d)" - id info.Xenctrl.dying info.Xenctrl.shutdown info.Xenctrl.shutdown_code; - if info.Xenctrl.dying then - dead_dom := id :: !dead_dom -@@ -43,7 +45,7 @@ - notify := true; - ) - with Xenctrl.Error _ -> -- Logs.debug "general" "Domain %u died -- no domain info" id; -+ debug "Domain %u died -- no domain info" id; - dead_dom := id :: !dead_dom; - ) doms.table; - List.iter (fun id -> ---- a/tools/ocaml/xenstored/logging.ml -+++ b/tools/ocaml/xenstored/logging.ml -@@ -17,21 +17,122 @@ - open Stdext - open Printf - --let error fmt = Logs.error "general" fmt --let info fmt = Logs.info "general" fmt --let debug fmt = Logs.debug "general" fmt - --let access_log_file = ref "/var/log/xenstored-access.log" --let access_log_nb_files = ref 20 --let access_log_nb_lines = ref 13215 --let activate_access_log = ref true -+(* Logger common *) -+ -+type logger = -+ { stop: unit -> unit; -+ restart: unit -> unit; -+ rotate: unit -> unit; -+ write: 'a. ('a, unit, string, unit) format4 -> 'a } -+ -+let truncate_line nb_chars line = -+ if String.length line > nb_chars - 1 then -+ let len = max (nb_chars - 1) 2 in -+ let dst_line = String.create len in -+ String.blit line 0 dst_line 0 (len - 2); -+ dst_line.[len-2] <- '.'; -+ dst_line.[len-1] <- '.'; -+ dst_line -+ else line -+ -+let log_rotate ref_ch log_file log_nb_files = -+ let file n = sprintf "%s.%i" log_file n in -+ let log_files = -+ let rec aux accu n = -+ if n >= log_nb_files then accu -+ else -+ if n = 1 && Sys.file_exists log_file -+ then aux [log_file,1] 2 -+ else -+ let file = file (n-1) in -+ if Sys.file_exists file then -+ aux ((file, n) :: accu) (n+1) -+ else accu in -+ aux [] 1 in -+ List.iter (fun (f, n) -> Unix.rename f (file n)) log_files; -+ close_out !ref_ch; -+ ref_ch := open_out log_file -+ -+let make_logger log_file log_nb_files log_nb_lines log_nb_chars post_rotate = -+ let channel = ref (open_out_gen [Open_append; Open_creat] 0o644 log_file) in -+ let counter = ref 0 in -+ let stop() = -+ try flush !channel; close_out !channel -+ with _ -> () in -+ let restart() = -+ stop(); -+ channel := open_out_gen [Open_append; Open_creat] 0o644 log_file in -+ let rotate() = -+ log_rotate channel log_file log_nb_files; -+ (post_rotate (): unit); -+ counter := 0 in -+ let output s = -+ let s = if log_nb_chars > 0 then truncate_line log_nb_chars s else s in -+ let s = s ^ "\n" in -+ output_string !channel s; -+ flush !channel; -+ incr counter; -+ if !counter > log_nb_lines then rotate() in -+ { stop=stop; restart=restart; rotate=rotate; write = fun fmt -> Printf.ksprintf output fmt } -+ -+ -+(* Xenstored logger *) -+ -+exception Unknown_level of string -+ -+type level = Debug | Info | Warn | Error | Null -+ -+let int_of_level = function -+ | Debug -> 0 | Info -> 1 | Warn -> 2 -+ | Error -> 3 | Null -> max_int -+ -+let string_of_level = function -+ | Debug -> "debug" | Info -> "info" | Warn -> "warn" -+ | Error -> "error" | Null -> "null" -+ -+let level_of_string = function -+ | "debug" -> Debug | "info" -> Info | "warn" -> Warn -+ | "error" -> Error | "null" -> Null | s -> raise (Unknown_level s) -+ -+let string_of_date () = -+ let time = Unix.gettimeofday () in -+ let tm = Unix.gmtime time in -+ let msec = time -. (floor time) in -+ sprintf "%d%.2d%.2dT%.2d:%.2d:%.2d.%.3dZ" -+ (1900 + tm.Unix.tm_year) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday -+ tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec -+ (int_of_float (1000.0 *. msec)) - --(* maximal size of the lines in xenstore-acces.log file *) --let line_size = 180 -+let xenstored_log_file = ref "/var/log/xenstored.log" -+let xenstored_log_level = ref Null -+let xenstored_log_nb_files = ref 10 -+let xenstored_log_nb_lines = ref 13215 -+let xenstored_log_nb_chars = ref (-1) -+let xenstored_logger = ref (None: logger option) -+ -+let init_xenstored_log () = -+ if !xenstored_log_level <> Null && !xenstored_log_nb_files > 0 then -+ let logger = -+ make_logger -+ !xenstored_log_file !xenstored_log_nb_files !xenstored_log_nb_lines -+ !xenstored_log_nb_chars ignore in -+ xenstored_logger := Some logger -+ -+let xenstored_logging level key (fmt: (_,_,_,_) format4) = -+ match !xenstored_logger with -+ | Some logger when int_of_level level >= int_of_level !xenstored_log_level -> -+ let date = string_of_date() in -+ let level = string_of_level level in -+ logger.write ("[%s|%5s|%s] " ^^ fmt) date level key -+ | _ -> Printf.ksprintf ignore fmt -+ -+let debug key = xenstored_logging Debug key -+let info key = xenstored_logging Info key -+let warn key = xenstored_logging Warn key -+let error key = xenstored_logging Error key - --let log_read_ops = ref false --let log_transaction_ops = ref false --let log_special_ops = ref false -+(* Access logger *) - - type access_type = - | Coalesce -@@ -41,38 +142,10 @@ - | Endconn - | XbOp of Xenbus.Xb.Op.operation - --type access = -- { -- fd: out_channel ref; -- counter: int ref; -- write: tid:int -> con:string -> ?data:string -> access_type -> unit; -- } -- --let string_of_date () = -- let time = Unix.gettimeofday () in -- let tm = Unix.localtime time in -- let msec = time -. (floor time) in -- sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d" (1900 + tm.Unix.tm_year) -- (tm.Unix.tm_mon + 1) -- tm.Unix.tm_mday -- tm.Unix.tm_hour -- tm.Unix.tm_min -- tm.Unix.tm_sec -- (int_of_float (1000.0 *. msec)) -- --let fill_with_space n s = -- if String.length s < n -- then -- let r = String.make n ' ' in -- String.blit s 0 r 0 (String.length s); -- r -- else -- s -- - let string_of_tid ~con tid = - if tid = 0 -- then fill_with_space 12 (sprintf "%s" con) -- else fill_with_space 12 (sprintf "%s.%i" con tid) -+ then sprintf "%-12s" con -+ else sprintf "%-12s" (sprintf "%s.%i" con tid) - - let string_of_access_type = function - | Coalesce -> "coalesce " -@@ -109,41 +182,9 @@ - - | Xenbus.Xb.Op.Error -> "error " - | Xenbus.Xb.Op.Watchevent -> "w event " -- -+ (* - | x -> Xenbus.Xb.Op.to_string x -- --let file_exists file = -- try -- Unix.close (Unix.openfile file [Unix.O_RDONLY] 0o644); -- true -- with _ -> -- false -- --let log_rotate fd = -- let file n = sprintf "%s.%i" !access_log_file n in -- let log_files = -- let rec aux accu n = -- if n >= !access_log_nb_files -- then accu -- else if n = 1 && file_exists !access_log_file -- then aux [!access_log_file,1] 2 -- else -- let file = file (n-1) in -- if file_exists file -- then aux ((file,n) :: accu) (n+1) -- else accu -- in -- aux [] 1 -- in -- let rec rename = function -- | (f,n) :: t when n < !access_log_nb_files -> -- Unix.rename f (file n); -- rename t -- | _ -> () -- in -- rename log_files; -- close_out !fd; -- fd := open_out !access_log_file -+ *) - - let sanitize_data data = - let data = String.copy data in -@@ -154,86 +195,68 @@ - done; - String.escaped data - --let make save_to_disk = -- let fd = ref (open_out_gen [Open_append; Open_creat] 0o644 !access_log_file) in -- let counter = ref 0 in -- { -- fd = fd; -- counter = counter; -- write = -- if not !activate_access_log || !access_log_nb_files = 0 -- then begin fun ~tid ~con ?data _ -> () end -- else fun ~tid ~con ?(data="") access_type -> -- let s = Printf.sprintf "[%s] %s %s %s\n" (string_of_date()) (string_of_tid ~con tid) -- (string_of_access_type access_type) (sanitize_data data) in -- let s = -- if String.length s > line_size -- then begin -- let s = String.sub s 0 line_size in -- s.[line_size-3] <- '.'; -- s.[line_size-2] <- '.'; -- s.[line_size-1] <- '\n'; -- s -- end else -- s -- in -- incr counter; -- output_string !fd s; -- flush !fd; -- if !counter > !access_log_nb_lines -- then begin -- log_rotate fd; -- save_to_disk (); -- counter := 0; -- end -- } -- --let access : (access option) ref = ref None --let init aal save_to_disk = -- activate_access_log := aal; -- access := Some (make save_to_disk) -- --let write_access_log ~con ~tid ?data access_type = -+let activate_access_log = ref true -+let access_log_file = ref "/var/log/xenstored-access.log" -+let access_log_nb_files = ref 20 -+let access_log_nb_lines = ref 13215 -+let access_log_nb_chars = ref 180 -+let access_log_read_ops = ref false -+let access_log_transaction_ops = ref false -+let access_log_special_ops = ref false -+let access_logger = ref None -+ -+let init_access_log post_rotate = -+ if !access_log_nb_files > 0 then -+ let logger = -+ make_logger -+ !access_log_file !access_log_nb_files !access_log_nb_lines -+ !access_log_nb_chars post_rotate in -+ access_logger := Some logger -+ -+let access_logging ~con ~tid ?(data="") access_type = - try -- maybe (fun a -> a.write access_type ~con ~tid ?data) !access -+ maybe -+ (fun logger -> -+ let date = string_of_date() in -+ let tid = string_of_tid ~con tid in -+ let access_type = string_of_access_type access_type in -+ let data = sanitize_data data in -+ logger.write "[%s] %s %s %s" date tid access_type data) -+ !access_logger - with _ -> () - --let new_connection = write_access_log Newconn --let end_connection = write_access_log Endconn -+let new_connection = access_logging Newconn -+let end_connection = access_logging Endconn - let read_coalesce ~tid ~con data = -- if !log_read_ops -- then write_access_log Coalesce ~tid ~con ~data:("read "^data) --let write_coalesce data = write_access_log Coalesce ~data:("write "^data) --let conflict = write_access_log Conflict --let commit = write_access_log Commit -+ if !access_log_read_ops -+ then access_logging Coalesce ~tid ~con ~data:("read "^data) -+let write_coalesce data = access_logging Coalesce ~data:("write "^data) -+let conflict = access_logging Conflict -+let commit = access_logging Commit - - let xb_op ~tid ~con ~ty data = -- let print = -- match ty with -- | Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !log_read_ops -+ let print = match ty with -+ | Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !access_log_read_ops - | Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end -> - false (* transactions are managed below *) - | Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume -> -- !log_special_ops -- | _ -> true -- in -- if print -- then write_access_log ~tid ~con ~data (XbOp ty) -+ !access_log_special_ops -+ | _ -> true in -+ if print then access_logging ~tid ~con ~data (XbOp ty) - - let start_transaction ~tid ~con = -- if !log_transaction_ops && tid <> 0 -- then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start) -+ if !access_log_transaction_ops && tid <> 0 -+ then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start) - - let end_transaction ~tid ~con = -- if !log_transaction_ops && tid <> 0 -- then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end) -+ if !access_log_transaction_ops && tid <> 0 -+ then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end) - - let xb_answer ~tid ~con ~ty data = - let print = match ty with -- | Xenbus.Xb.Op.Error when data="ENOENT " -> !log_read_ops -- | Xenbus.Xb.Op.Error -> !log_special_ops -+ | Xenbus.Xb.Op.Error when String.startswith "ENOENT " data -> !access_log_read_ops -+ | Xenbus.Xb.Op.Error -> true - | Xenbus.Xb.Op.Watchevent -> true - | _ -> false - in -- if print -- then write_access_log ~tid ~con ~data (XbOp ty) -+ if print then access_logging ~tid ~con ~data (XbOp ty) ---- a/tools/ocaml/xenstored/perms.ml -+++ b/tools/ocaml/xenstored/perms.ml -@@ -15,6 +15,8 @@ - * GNU Lesser General Public License for more details. - *) - -+let info fmt = Logging.info "perms" fmt -+ - open Stdext - - let activate = ref true -@@ -145,16 +147,16 @@ - in - match perm, request with - | NONE, _ -> -- Logs.info "io" "Permission denied: Domain %d has no permission" domainid; -+ info "Permission denied: Domain %d has no permission" domainid; - false - | RDWR, _ -> true - | READ, READ -> true - | WRITE, WRITE -> true - | READ, _ -> -- Logs.info "io" "Permission denied: Domain %d has read only access" domainid; -+ info "Permission denied: Domain %d has read only access" domainid; - false - | WRITE, _ -> -- Logs.info "io" "Permission denied: Domain %d has write only access" domainid; -+ info "Permission denied: Domain %d has write only access" domainid; - false - in - if !activate ---- a/tools/ocaml/xenstored/process.ml -+++ b/tools/ocaml/xenstored/process.ml -@@ -14,6 +14,9 @@ - * GNU Lesser General Public License for more details. - *) - -+let error fmt = Logging.error "process" fmt -+let info fmt = Logging.info "process" fmt -+ - open Printf - open Stdext - -@@ -79,7 +82,7 @@ - - (* packets *) - let do_debug con t domains cons data = -- if not !allow_debug -+ if not (Connection.is_dom0 con) && not !allow_debug - then None - else try match split None '\000' data with - | "print" :: msg :: _ -> -@@ -89,6 +92,9 @@ - let domid = int_of_string domid in - let quota = (Store.get_quota t.Transaction.store) in - Some (Quota.to_string quota domid ^ "\000") -+ | "watches" :: _ -> -+ let watches = Connections.debug cons in -+ Some (watches ^ "\000") - | "mfn" :: domid :: _ -> - let domid = int_of_string domid in - let con = Connections.find_domain cons domid in -@@ -357,8 +363,7 @@ - in - input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data; - with exn -> -- Logs.error "general" "process packet: %s" -- (Printexc.to_string exn); -+ error "process packet: %s" (Printexc.to_string exn); - Connection.send_error con tid rid "EIO" - - let write_access_log ~ty ~tid ~con ~data = -@@ -372,7 +377,7 @@ - let packet = Connection.pop_in con in - let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in - (* As we don't log IO, do not call an unnecessary sanitize_data -- Logs.info "io" "[%s] -> [%d] %s \"%s\"" -+ info "[%s] -> [%d] %s \"%s\"" - (Connection.get_domstr con) tid - (Xenbus.Xb.Op.to_string ty) (sanitize_data data); *) - process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data; -@@ -386,7 +391,7 @@ - let packet = Connection.peek_output con in - let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in - (* As we don't log IO, do not call an unnecessary sanitize_data -- Logs.info "io" "[%s] <- %s \"%s\"" -+ info "[%s] <- %s \"%s\"" - (Connection.get_domstr con) - (Xenbus.Xb.Op.to_string ty) (sanitize_data data);*) - write_answer_log ~ty ~tid ~con ~data; ---- a/tools/ocaml/xenstored/quota.ml -+++ b/tools/ocaml/xenstored/quota.ml -@@ -18,7 +18,7 @@ - exception Data_too_big - exception Transaction_opened - --let warn fmt = Logs.warn "general" fmt -+let warn fmt = Logging.warn "quota" fmt - let activate = ref true - let maxent = ref (10000) - let maxsize = ref (4096) ---- a/tools/ocaml/xenstored/store.ml -+++ b/tools/ocaml/xenstored/store.ml -@@ -83,7 +83,7 @@ - let check_owner node connection = - if not (Perms.check_owner connection node.perms) - then begin -- Logs.info "io" "Permission denied: Domain %d not owner" (get_owner node); -+ Logging.info "store|node" "Permission denied: Domain %d not owner" (get_owner node); - raise Define.Permission_denied; - end - ---- a/tools/ocaml/xenstored/xenstored.conf -+++ b/tools/ocaml/xenstored/xenstored.conf -@@ -22,9 +22,14 @@ - # Activate filed base backend - persistant = false - --# Logs --log = error;general;file:/var/log/xenstored.log --log = warn;general;file:/var/log/xenstored.log --log = info;general;file:/var/log/xenstored.log -+# Xenstored logs -+# xenstored-log-file = /var/log/xenstored.log -+# xenstored-log-level = null -+# xenstored-log-nb-files = 10 -+ -+# Xenstored access logs -+# access-log-file = /var/log/xenstored-access.log -+# access-log-nb-lines = 13215 -+# acesss-log-nb-chars = 180 -+# access-log-special-ops = false - --# log = debug;io;file:/var/log/xenstored-io.log ---- a/tools/ocaml/xenstored/xenstored.ml -+++ b/tools/ocaml/xenstored/xenstored.ml -@@ -18,7 +18,10 @@ - open Printf - open Parse_arg - open Stdext --open Logging -+ -+let error fmt = Logging.error "xenstored" fmt -+let debug fmt = Logging.debug "xenstored" fmt -+let info fmt = Logging.info "xenstored" fmt - - (*------------ event klass processors --------------*) - let process_connection_fds store cons domains rset wset = -@@ -64,7 +67,8 @@ - () - - let sighup_handler _ = -- try Logs.reopen (); info "Log re-opened" with _ -> () -+ maybe (fun logger -> logger.Logging.restart()) !Logging.xenstored_logger; -+ maybe (fun logger -> logger.Logging.restart()) !Logging.access_logger - - let config_filename cf = - match cf.config_file with -@@ -75,26 +79,6 @@ - - let parse_config filename = - let pidfile = ref default_pidfile in -- let set_log s = -- let ls = String.split ~limit:3 ';' s in -- let level, key, logger = match ls with -- | [ level; key; logger ] -> level, key, logger -- | _ -> failwith "format mismatch: expecting 3 arguments" in -- -- let loglevel = match level with -- | "debug" -> Log.Debug -- | "info" -> Log.Info -- | "warn" -> Log.Warn -- | "error" -> Log.Error -- | s -> failwith (sprintf "Unknown log level: %s" s) in -- -- (* if key is empty, append to the default logger *) -- let append = -- if key = "" then -- Logs.append_default -- else -- Logs.append key in -- append loglevel logger in - let options = [ - ("merge-activate", Config.Set_bool Transaction.do_coalesce); - ("perms-activate", Config.Set_bool Perms.activate); -@@ -104,14 +88,20 @@ - ("quota-maxentity", Config.Set_int Quota.maxent); - ("quota-maxsize", Config.Set_int Quota.maxsize); - ("test-eagain", Config.Set_bool Transaction.test_eagain); -- ("log", Config.String set_log); - ("persistant", Config.Set_bool Disk.enable); -+ ("xenstored-log-file", Config.Set_string Logging.xenstored_log_file); -+ ("xenstored-log-level", Config.String -+ (fun s -> Logging.xenstored_log_level := Logging.level_of_string s)); -+ ("xenstored-log-nb-files", Config.Set_int Logging.xenstored_log_nb_files); -+ ("xenstored-log-nb-lines", Config.Set_int Logging.xenstored_log_nb_lines); -+ ("xenstored-log-nb-chars", Config.Set_int Logging.xenstored_log_nb_chars); - ("access-log-file", Config.Set_string Logging.access_log_file); - ("access-log-nb-files", Config.Set_int Logging.access_log_nb_files); - ("access-log-nb-lines", Config.Set_int Logging.access_log_nb_lines); -- ("access-log-read-ops", Config.Set_bool Logging.log_read_ops); -- ("access-log-transactions-ops", Config.Set_bool Logging.log_transaction_ops); -- ("access-log-special-ops", Config.Set_bool Logging.log_special_ops); -+ ("access-log-nb-chars", Config.Set_int Logging.access_log_nb_chars); -+ ("access-log-read-ops", Config.Set_bool Logging.access_log_read_ops); -+ ("access-log-transactions-ops", Config.Set_bool Logging.access_log_transaction_ops); -+ ("access-log-special-ops", Config.Set_bool Logging.access_log_special_ops); - ("allow-debug", Config.Set_bool Process.allow_debug); - ("pid-file", Config.Set_string pidfile); ] in - begin try Config.read filename options (fun _ _ -> raise Not_found) -@@ -223,9 +213,6 @@ - end - - let _ = -- printf "Xen Storage Daemon, version %d.%d\n%!" -- Define.xenstored_major Define.xenstored_minor; -- - let cf = do_argv in - let pidfile = - if Sys.file_exists (config_filename cf) then -@@ -249,13 +236,13 @@ - in - - if cf.daemonize then -- Unixext.daemonize (); -+ Unixext.daemonize () -+ else -+ printf "Xen Storage Daemon, version %d.%d\n%!" -+ Define.xenstored_major Define.xenstored_minor; - - (try Unixext.pidfile_write pidfile with _ -> ()); - -- info "Xen Storage Daemon, version %d.%d" -- Define.xenstored_major Define.xenstored_minor; -- - (* for compatilibity with old xenstored *) - begin match cf.pidfile with - | Some pidfile -> Unixext.pidfile_write pidfile -@@ -293,7 +280,14 @@ - Sys.set_signal Sys.sigusr1 (Sys.Signal_handle (fun i -> sigusr1_handler store)); - Sys.set_signal Sys.sigpipe Sys.Signal_ignore; - -- Logging.init cf.activate_access_log (fun () -> DB.to_file store cons "/var/run/xenstored/db"); -+ Logging.init_xenstored_log(); -+ if cf.activate_access_log then begin -+ let post_rotate () = DB.to_file store cons "/var/run/xenstored/db" in -+ Logging.init_access_log post_rotate -+ end; -+ -+ info "Xen Storage Daemon, version %d.%d" -+ Define.xenstored_major Define.xenstored_minor; - - let spec_fds = - (match rw_sock with None -> [] | Some x -> [ x ]) @ ---- a/tools/ocaml/libs/log/syslog.mli -+++ /dev/null -@@ -1,41 +0,0 @@ --(* -- * Copyright (C) 2006-2007 XenSource Ltd. -- * Copyright (C) 2008 Citrix Ltd. -- * Author Vincent Hanquez -- * -- * 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 level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug --type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid --type facility = -- Auth -- | Authpriv -- | Cron -- | Daemon -- | Ftp -- | Kern -- | Local0 -- | Local1 -- | Local2 -- | Local3 -- | Local4 -- | Local5 -- | Local6 -- | Local7 -- | Lpr -- | Mail -- | News -- | Syslog -- | User -- | Uucp --external log : facility -> level -> string -> unit = "stub_syslog" --external close : unit -> unit = "stub_closelog" ---- a/tools/ocaml/libs/log/Makefile -+++ /dev/null -@@ -1,44 +0,0 @@ --TOPLEVEL=$(CURDIR)/../.. --XEN_ROOT=$(TOPLEVEL)/../.. --include $(TOPLEVEL)/common.make -- --OBJS = syslog log logs --INTF = log.cmi logs.cmi syslog.cmi --LIBS = log.cma log.cmxa -- --all: $(INTF) $(LIBS) $(PROGRAMS) -- --bins: $(PROGRAMS) -- --libs: $(LIBS) -- --log.cmxa: libsyslog_stubs.a $(foreach obj,$(OBJS),$(obj).cmx) -- $(call mk-caml-lib-native, $@, -cclib -lsyslog_stubs, $(foreach obj,$(OBJS),$(obj).cmx)) -- --log.cma: $(foreach obj,$(OBJS),$(obj).cmo) -- $(call mk-caml-lib-bytecode, $@, -dllib dllsyslog_stubs.so -cclib -lsyslog_stubs, $(foreach obj,$(OBJS),$(obj).cmo)) -- --syslog_stubs.a: syslog_stubs.o -- $(call mk-caml-stubs, $@, $+) -- --libsyslog_stubs.a: syslog_stubs.o -- $(call mk-caml-lib-stubs, $@, $+) -- --logs.mli : logs.ml -- $(OCAMLC) -i $(OCAMLCFLAGS) $< > $@ -- --syslog.mli : syslog.ml -- $(OCAMLC) -i $< > $@ -- --.PHONY: install --install: $(LIBS) META -- mkdir -p $(OCAMLDESTDIR) -- ocamlfind remove -destdir $(OCAMLDESTDIR) log -- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore log META $(INTF) $(LIBS) *.a *.so *.cmx -- --.PHONY: uninstall --uninstall: -- ocamlfind remove -destdir $(OCAMLDESTDIR) log -- --include $(TOPLEVEL)/Makefile.rules -- diff --git a/upstream-23940:187d59e32a58 b/upstream-23940:187d59e32a58 deleted file mode 100644 index 2c7521a..0000000 --- a/upstream-23940:187d59e32a58 +++ /dev/null @@ -1,45 +0,0 @@ -# HG changeset patch -# User Jon Ludlam -# Date 1318261276 -3600 -# Node ID 187d59e32a586d65697ed46bef106b52e3fb5ab9 -# Parent 51288f69523fcbbefa12cea5a761a6e957410151 -tools/ocaml: Fix 2 bit-twiddling bugs and an off-by-one - -The bit bugs are in ocaml vcpu affinity calls, and the off-by-one -error is in the ocaml console ring code - -Signed-off-by: Zheng Li -Acked-by: Ian Campbell -Committed-by: Ian Jackson -Acked-by: Jon Ludlam - -diff -r 51288f69523f -r 187d59e32a58 tools/ocaml/libs/xc/xenctrl_stubs.c ---- a/tools/ocaml/libs/xc/xenctrl_stubs.c Mon Oct 10 16:41:16 2011 +0100 -+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c Mon Oct 10 16:41:16 2011 +0100 -@@ -430,7 +430,7 @@ - - for (i=0; i -# Date 1346844474 -3600 -# Node ID bcc3402927311c64cc04e59d3680680b09459da6 -# Parent d28a9ba889c02f835df05bc007c2b4828d86cff2 -xen: prevent a 64 bit guest setting reserved bits in DR7 - -The upper 32 bits of this register are reserved and should be written as -zero. - -This is XSA-12 / CVE-2012-3494 - -Signed-off-by: Jan Beulich -Reviewed-by: Ian Campbell - -diff -r d28a9ba889c0 -r bcc340292731 xen/include/asm-x86/debugreg.h ---- a/xen/include/asm-x86/debugreg.h Tue Sep 04 14:56:48 2012 +0200 -+++ b/xen/include/asm-x86/debugreg.h Wed Sep 05 12:27:54 2012 +0100 -@@ -58,7 +58,7 @@ - We can slow the instruction pipeline for instructions coming via the - gdt or the ldt if we want to. I am not sure why this is an advantage */ - --#define DR_CONTROL_RESERVED_ZERO (0x0000d800ul) /* Reserved, read as zero */ -+#define DR_CONTROL_RESERVED_ZERO (~0xffff27fful) /* Reserved, read as zero */ - #define DR_CONTROL_RESERVED_ONE (0x00000400ul) /* Reserved, read as one */ - #define DR_LOCAL_EXACT_ENABLE (0x00000100ul) /* Local exact enable */ - #define DR_GLOBAL_EXACT_ENABLE (0x00000200ul) /* Global exact enable */ - diff --git a/xen-4.1-testing.23350.patch b/xen-4.1-testing.23350.patch deleted file mode 100644 index e73dd17..0000000 --- a/xen-4.1-testing.23350.patch +++ /dev/null @@ -1,37 +0,0 @@ - -# HG changeset patch -# User Ian Jackson -# Date 1346844497 -3600 -# Node ID 6779ddca8593b766ccabcfec294ba10f17e68484 -# Parent bcc3402927311c64cc04e59d3680680b09459da6 -xen: handle out-of-pirq condition correctly in PHYSDEVOP_get_free_pirq - -This is XSA-13 / CVE-2012-3495 - -Signed-off-by: Ian Campbell -Signed-off-by: Jan Beulich - -diff -r bcc340292731 -r 6779ddca8593 xen/arch/x86/physdev.c ---- a/xen/arch/x86/physdev.c Wed Sep 05 12:27:54 2012 +0100 -+++ b/xen/arch/x86/physdev.c Wed Sep 05 12:28:17 2012 +0100 -@@ -587,11 +587,16 @@ ret_t do_physdev_op(int cmd, XEN_GUEST_H - break; - - spin_lock(&d->event_lock); -- out.pirq = get_free_pirq(d, out.type, 0); -- d->arch.pirq_irq[out.pirq] = PIRQ_ALLOCATED; -+ ret = get_free_pirq(d, out.type, 0); -+ if ( ret >= 0 ) -+ d->arch.pirq_irq[ret] = PIRQ_ALLOCATED; - spin_unlock(&d->event_lock); - -- ret = copy_to_guest(arg, &out, 1) ? -EFAULT : 0; -+ if ( ret >= 0 ) -+ { -+ out.pirq = ret; -+ ret = copy_to_guest(arg, &out, 1) ? -EFAULT : 0; -+ } - - rcu_unlock_domain(d); - break; - diff --git a/xen-4.1-testing.23351.patch b/xen-4.1-testing.23351.patch deleted file mode 100644 index f45eba7..0000000 --- a/xen-4.1-testing.23351.patch +++ /dev/null @@ -1,28 +0,0 @@ - -# HG changeset patch -# User Ian Jackson -# Date 1346844545 -3600 -# Node ID 8ebda5388e4e83a69c73bdd7621e76e1de4fc995 -# Parent 6779ddca8593b766ccabcfec294ba10f17e68484 -xen: Don't BUG_ON() PoD operations on a non-translated guest. - -This is XSA-14 / CVE-2012-3496 - -Signed-off-by: Tim Deegan -Reviewed-by: Ian Campbell -Tested-by: Ian Campbell - -diff -r 6779ddca8593 -r 8ebda5388e4e xen/arch/x86/mm/p2m.c ---- a/xen/arch/x86/mm/p2m.c Wed Sep 05 12:28:17 2012 +0100 -+++ b/xen/arch/x86/mm/p2m.c Wed Sep 05 12:29:05 2012 +0100 -@@ -2414,7 +2414,8 @@ guest_physmap_mark_populate_on_demand(st - int pod_count = 0; - int rc = 0; - -- BUG_ON(!paging_mode_translate(d)); -+ if ( !paging_mode_translate(d) ) -+ return -EINVAL; - - rc = gfn_check_limit(d, gfn, order); - if ( rc != 0 ) - diff --git a/xen-4.1-testing.23352.patch b/xen-4.1-testing.23352.patch deleted file mode 100644 index 588701c..0000000 --- a/xen-4.1-testing.23352.patch +++ /dev/null @@ -1,38 +0,0 @@ - -# HG changeset patch -# User Ian Jackson -# Date 1346844596 -3600 -# Node ID 936f63ee4dadb832222c029e958ae7c7564ec0e8 -# Parent 8ebda5388e4e83a69c73bdd7621e76e1de4fc995 -x86/pvhvm: properly range-check PHYSDEVOP_map_pirq/MAP_PIRQ_TYPE_GSI - -This is being used as a array index, and hence must be validated before -use. - -This is XSA-16 / CVE-2012-3498. - -Signed-off-by: Jan Beulich - -diff -r 8ebda5388e4e -r 936f63ee4dad xen/arch/x86/physdev.c ---- a/xen/arch/x86/physdev.c Wed Sep 05 12:29:05 2012 +0100 -+++ b/xen/arch/x86/physdev.c Wed Sep 05 12:29:56 2012 +0100 -@@ -40,11 +40,18 @@ static int physdev_hvm_map_pirq( - struct hvm_girq_dpci_mapping *girq; - uint32_t machine_gsi = 0; - -+ if ( map->index < 0 || map->index >= NR_HVM_IRQS ) -+ { -+ ret = -EINVAL; -+ break; -+ } -+ - /* find the machine gsi corresponding to the - * emulated gsi */ - hvm_irq_dpci = domain_get_irq_dpci(d); - if ( hvm_irq_dpci ) - { -+ BUILD_BUG_ON(ARRAY_SIZE(hvm_irq_dpci->girq) < NR_HVM_IRQS); - list_for_each_entry ( girq, - &hvm_irq_dpci->girq[map->index], - list ) - diff --git a/xen-backend.rules.patch b/xen-backend.rules.patch deleted file mode 100644 index 76a36b1..0000000 --- a/xen-backend.rules.patch +++ /dev/null @@ -1,8 +0,0 @@ ---- xen-4.1.2/tools/hotplug/Linux/xen-backend.rules.orig 2011-10-20 18:05:42.000000000 +0100 -+++ xen-4.1.2/tools/hotplug/Linux/xen-backend.rules 2012-04-15 17:08:24.774955932 +0100 -@@ -13,4 +13,4 @@ - KERNEL=="gntdev", NAME="xen/%k", MODE="0600" - KERNEL=="pci_iomul", NAME="xen/%k", MODE="0600" - KERNEL=="tapdev[a-z]*", NAME="xen/blktap-2/tapdev%m", MODE="0600" --SUBSYSTEM=="net", KERNEL=="tap*", ACTION=="add", RUN+="/etc/xen/scripts/vif-setup $env{ACTION} type_if=tap" -+SUBSYSTEM=="net", KERNEL=="tap[0-9]*.[0-9]*", ACTION=="add", RUN+="/etc/xen/scripts/vif-setup $env{ACTION} type_if=tap" diff --git a/xen-net-disable-iptables-on-bridge.patch b/xen-net-disable-iptables-on-bridge.patch index e7a8930..53383cf 100644 --- a/xen-net-disable-iptables-on-bridge.patch +++ b/xen-net-disable-iptables-on-bridge.patch @@ -8,9 +8,9 @@ - handle_iptable -fi - + call_hooks vif post + log debug "Successful vif-bridge $command for $dev, bridge $bridge." - if [ "$type_if" = vif -a "$command" = "online" ] - then --- xen-3.3.0-orig/tools/hotplug/Linux/xen-network-common.sh 2008-08-22 10:49:07.000000000 +0100 +++ xen-3.3.0-new/tools/hotplug/Linux/xen-network-common.sh 2008-08-29 11:29:38.000000000 +0100 @@ -99,6 +99,13 @@ create_bridge () { diff --git a/xen-no-pyxml.patch b/xen-no-pyxml.patch deleted file mode 100644 index 276994b..0000000 --- a/xen-no-pyxml.patch +++ /dev/null @@ -1,13 +0,0 @@ -diff -up xen-4.1.2/tools/python/xen/xm/create.py.bak xen-4.1.2/tools/python/xen/xm/create.py ---- xen-4.1.2/tools/python/xen/xm/create.py.bak 2012-07-24 10:23:05.096849992 -0700 -+++ xen-4.1.2/tools/python/xen/xm/create.py 2012-07-24 10:23:34.453610629 -0700 -@@ -1538,8 +1538,7 @@ def main(argv): - SXPPrettyPrint.prettyprint(config) - - if opts.vals.xmldryrun and serverType == SERVER_XEN_API: -- from xml.dom.ext import PrettyPrint as XMLPrettyPrint -- XMLPrettyPrint(doc) -+ print doc.toprettyxml() - - if opts.vals.dryrun or opts.vals.xmldryrun: - return diff --git a/xen.fedora.efi.build.patch b/xen.fedora.efi.build.patch new file mode 100644 index 0000000..1a66098 --- /dev/null +++ b/xen.fedora.efi.build.patch @@ -0,0 +1,46 @@ +--- xen-4.2.0/xen/arch/x86/Makefile.orig 2012-05-12 16:40:48.000000000 +0100 ++++ xen-4.2.0/xen/arch/x86/Makefile 2012-08-02 21:47:39.849910608 +0100 +@@ -126,18 +126,18 @@ + $(TARGET).efi: guard = $(if $(shell echo efi/dis* | grep disabled),:) + $(TARGET).efi: prelink-efi.o efi.lds efi/relocs-dummy.o $(BASEDIR)/common/symbols-dummy.o efi/mkreloc + $(foreach base, $(VIRT_BASE) $(ALT_BASE), \ +- $(guard) $(LD) $(call EFI_LDFLAGS,$(base)) -T efi.lds -N $< efi/relocs-dummy.o \ ++ $(guard) $(LD_EFI) $(call EFI_LDFLAGS,$(base)) -T efi.lds -N $< efi/relocs-dummy.o \ + $(BASEDIR)/common/symbols-dummy.o -o $(@D)/.$(@F).$(base).0 &&) : + $(guard) efi/mkreloc $(foreach base,$(VIRT_BASE) $(ALT_BASE),$(@D)/.$(@F).$(base).0) >$(@D)/.$(@F).0r.S + $(guard) $(NM) -n $(@D)/.$(@F).$(VIRT_BASE).0 | $(guard) $(BASEDIR)/tools/symbols >$(@D)/.$(@F).0s.S + $(guard) $(MAKE) -f $(BASEDIR)/Rules.mk $(@D)/.$(@F).0r.o $(@D)/.$(@F).0s.o + $(foreach base, $(VIRT_BASE) $(ALT_BASE), \ +- $(guard) $(LD) $(call EFI_LDFLAGS,$(base)) -T efi.lds -N $< \ ++ $(guard) $(LD_EFI) $(call EFI_LDFLAGS,$(base)) -T efi.lds -N $< \ + $(@D)/.$(@F).0r.o $(@D)/.$(@F).0s.o -o $(@D)/.$(@F).$(base).1 &&) : + $(guard) efi/mkreloc $(foreach base,$(VIRT_BASE) $(ALT_BASE),$(@D)/.$(@F).$(base).1) >$(@D)/.$(@F).1r.S + $(guard) $(NM) -n $(@D)/.$(@F).$(VIRT_BASE).1 | $(guard) $(BASEDIR)/tools/symbols >$(@D)/.$(@F).1s.S + $(guard) $(MAKE) -f $(BASEDIR)/Rules.mk $(@D)/.$(@F).1r.o $(@D)/.$(@F).1s.o +- $(guard) $(LD) $(call EFI_LDFLAGS,$(VIRT_BASE)) -T efi.lds -N $< \ ++ $(guard) $(LD_EFI) $(call EFI_LDFLAGS,$(VIRT_BASE)) -T efi.lds -N $< \ + $(@D)/.$(@F).1r.o $(@D)/.$(@F).1s.o -o $@ + if $(guard) false; then rm -f $@; echo 'EFI support disabled'; fi + rm -f $(@D)/.$(@F).[0-9]* +--- xen-4.2.0/xen/arch/x86/efi/Makefile.orig 2012-05-12 16:40:48.000000000 +0100 ++++ xen-4.2.0/xen/arch/x86/efi/Makefile 2012-08-02 22:01:43.956357825 +0100 +@@ -6,7 +6,7 @@ + + efi := $(filter y,$(x86_64)$(shell rm -f disabled)) + efi := $(if $(efi),$(shell $(CC) $(filter-out $(CFLAGS-y),$(CFLAGS)) -c check.c 2>disabled && echo y)) +-efi := $(if $(efi),$(shell $(LD) -mi386pep --subsystem=10 -o check.efi check.o 2>disabled && echo y)) ++efi := $(if $(efi),$(shell $(LD_EFI) -mi386pep --subsystem=10 -o check.efi check.o 2>disabled && echo y)) + efi := $(if $(efi),$(shell rm disabled)y,$(shell $(call create,boot.init.o); $(call create,runtime.o))) + + extra-$(efi) += boot.init.o relocs-dummy.o runtime.o compat.o +--- xen-4.2.0/xen/Makefile.orig 2012-07-30 19:21:20.000000000 +0100 ++++ xen-4.2.0/xen/Makefile 2012-08-02 22:07:22.801121685 +0100 +@@ -13,6 +13,8 @@ + export XEN_ROOT := $(BASEDIR)/.. + + EFI_MOUNTPOINT ?= /boot/efi ++EFI_VENDOR=fedora ++LD_EFI ?= $(LD) + + .PHONY: default + default: build diff --git a/xen.spec b/xen.spec index d653de4..f584b5c 100644 --- a/xen.spec +++ b/xen.spec @@ -3,6 +3,13 @@ # or ocamlopt is missing (the xen makefile doesn't build ocaml bits if it isn't there) %define with_ocaml %{?_without_ocaml: 0} %{?!_without_ocaml: 1} %define build_ocaml %(test -x %{_bindir}/ocamlopt && echo %{with_ocaml} || echo 0) +# build an efi boot image (where supported) unless rpmbuild was run with +# --without efi +%define build_efi %{?_without_efi: 0} %{?!_without_efi: 1} +# xen only supports efi boot images on x86_64 +%ifnarch x86_64 +%define build_efi 0 +%endif %if "%dist" >= ".fc17" %define with_sysv 0 %else @@ -15,12 +22,12 @@ %endif # Hypervisor ABI -%define hv_abi 4.1 +%define hv_abi 4.2 Summary: Xen is a virtual machine monitor Name: xen -Version: 4.1.3 -Release: 6%{?dist} +Version: 4.2.0 +Release: 1%{?dist} Group: Development/Libraries License: GPLv2+ and LGPLv2+ and BSD URL: http://xen.org/ @@ -33,7 +40,6 @@ Source11: newlib-1.16.0.tar.gz Source12: zlib-1.2.3.tar.gz Source13: pciutils-2.2.9.tar.bz2 Source14: grub-0.97.tar.gz -Source15: ipxe-git-v1.0.0.tar.gz # init.d bits Source20: init.xenstored Source21: init.xenconsoled @@ -53,42 +59,32 @@ Source45: xenconsoled.service Source46: xen-watchdog.service Source47: xendomains.service Source48: libexec.xendomains +Source49: tmpfiles.d.xen.conf Patch1: xen-initscript.patch Patch4: xen-dumpdir.patch Patch5: xen-net-disable-iptables-on-bridge.patch -Patch23: grub-ext4-support.patch Patch28: pygrubfix.patch Patch34: xend.catchbt.patch Patch35: xend-pci-loop.patch -Patch38: xen-backend.rules.patch Patch39: xend.selinux.fixes.patch -Patch40: pygrub.size.limits.patch -Patch45: xen-no-pyxml.patch - -Patch50: upstream-23936:cdb34816a40a-rework -Patch51: upstream-23937:5173834e8476 -Patch52: upstream-23938:fa04fbd56521-rework -Patch53: upstream-23939:51288f69523f-rework -Patch54: upstream-23940:187d59e32a58 - -Patch60: xen-4.1-testing.23349.patch -Patch61: xen-4.1-testing.23350.patch -Patch62: xen-4.1-testing.23351.patch -Patch63: xen-4.1-testing.23352.patch -Patch64: qemu-xen-4.1-testing.git-3220480734832a148d26f7a81f90af61c2ecfdd9.patch -Patch65: qemu-xen-4.1-testing.git-d7d453f51459b591faa96d1c123b5bfff7c5b6b6.patch +Patch46: xen.use.fedora.seabios.patch +Patch47: xen.use.fedora.ipxe.patch +Patch48: qemu-xen.tradonly.patch +Patch49: xen.fedora.efi.build.patch Patch100: xen-configure-xend.patch BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root BuildRequires: transfig libidn-devel zlib-devel texi2html SDL-devel curl-devel -BuildRequires: libX11-devel python-devel ghostscript -BuildRequires: texlive-latex texlive-times texlive-courier texlive-helvetic +BuildRequires: libX11-devel python-devel ghostscript texlive-latex +%if "%dist" >= ".fc18" +BuildRequires: texlive-times texlive-courier texlive-helvetic +%endif BuildRequires: ncurses-devel gtk2-devel libaio-devel # for the docs -BuildRequires: perl texinfo +BuildRequires: perl texinfo graphviz # so that the makefile knows to install udev rules BuildRequires: udev %ifnarch ia64 @@ -106,10 +102,14 @@ BuildRequires: pciutils-devel BuildRequires: libuuid-devel # iasl needed to build hvmloader BuildRequires: iasl +# build using Fedora seabios and ipxe packages for roms +BuildRequires: seabios-bin ipxe-roms-qemu # modern compressed kernels BuildRequires: bzip2-devel xz-devel # libfsimage BuildRequires: e2fsprogs-devel +# tools now require yajl +BuildRequires: yajl-devel Requires: bridge-utils Requires: python-lxml Requires: udev >= 059 @@ -124,6 +124,10 @@ ExclusiveArch: %{ix86} x86_64 ia64 %if %with_ocaml BuildRequires: ocaml, ocaml-findlib %endif +# efi image needs an ld that has -mi386pep option +%if %build_efi +BuildRequires: mingw64-binutils +%endif %description This package contains the XenD daemon and xm command line @@ -227,39 +231,30 @@ manage Xen virtual machines. %patch28 -p1 %patch34 -p1 %patch35 -p1 -%patch38 -p1 %patch39 -p1 -%patch40 -p1 -%patch45 -p1 - -%patch50 -p1 -%patch51 -p1 -%patch52 -p1 -%patch53 -p1 -%patch54 -p1 - -%patch60 -p1 -%patch61 -p1 -%patch62 -p1 -%patch63 -p1 -%patch64 -p1 -%patch65 -p1 +%patch46 -p1 +%patch47 -p1 +%patch48 -p1 +%patch49 -p1 %patch100 -p1 # stubdom sources cp -v %{SOURCE10} %{SOURCE11} %{SOURCE12} %{SOURCE13} %{SOURCE14} stubdom -cp -v %{PATCH23} stubdom/grub.patches/99grub-ext4-support.patch -cp -v %{SOURCE15} tools/firmware/etherboot/ipxe.tar.gz %build %if !%build_ocaml %define ocaml_flags OCAML_TOOLS=n %endif +%if %build_efi +%define efi_flags LD_EFI=/usr/x86_64-w64-mingw32/bin/ld +mkdir -p dist/install/boot/efi/efi/fedora +%endif export XEN_VENDORVERSION="-%{release}" export CFLAGS="$RPM_OPT_FLAGS" -make %{?_smp_mflags} prefix=/usr dist-xen +make %{?_smp_mflags} %{?efi_flags} prefix=/usr dist-xen +./configure --libdir=%{_libdir} make %{?_smp_mflags} %{?ocaml_flags} prefix=/usr dist-tools make prefix=/usr dist-docs unset CFLAGS @@ -271,10 +266,16 @@ rm -rf %{buildroot} %if %build_ocaml mkdir -p %{buildroot}%{_libdir}/ocaml/stublibs %endif -make DESTDIR=%{buildroot} prefix=/usr install-xen +%if %build_efi +mkdir -p %{buildroot}/boot/efi/efi/fedora +%endif +make DESTDIR=%{buildroot} %{?efi_flags} prefix=/usr install-xen make DESTDIR=%{buildroot} %{?ocaml_flags} prefix=/usr install-tools make DESTDIR=%{buildroot} prefix=/usr install-docs make DESTDIR=%{buildroot} %{?ocaml_flags} prefix=/usr install-stubdom +%if %build_efi +mv %{buildroot}/boot/efi/efi %{buildroot}/boot/efi/EFI +%endif ############ debug packaging: list files ############ @@ -317,6 +318,11 @@ rm -rf %{buildroot}/usr/info # adhere to Static Library Packaging Guidelines rm -rf %{buildroot}/%{_libdir}/*.a +%if %build_efi +# clean up extra efi files +rm -rf %{buildroot}/%{_libdir}/efi +%endif + ############ fixup files in /etc ############ # udev @@ -366,6 +372,8 @@ install -m 644 %{SOURCE46} %{buildroot}%{_unitdir}/xen-watchdog.service install -m 644 %{SOURCE47} %{buildroot}%{_unitdir}/xendomains.service mkdir -p %{buildroot}%{_libexecdir} install -m 644 %{SOURCE48} %{buildroot}%{_libexecdir}/xendomains +mkdir -p %{buildroot}/usr/lib/tmpfiles.d +install -m 644 %{SOURCE49} %{buildroot}/usr/lib/tmpfiles.d/xen.conf %endif # config file only used for hotplug, Fedora uses udev instead @@ -549,6 +557,7 @@ rm -rf %{buildroot} %{_unitdir}/blktapctrl.service %{_unitdir}/xenconsoled.service %{_unitdir}/xen-watchdog.service +/usr/lib/tmpfiles.d/xen.conf %endif %config(noreplace) %{_sysconfdir}/sysconfig/xenstored @@ -557,6 +566,7 @@ rm -rf %{buildroot} %config(noreplace) %{_sysconfdir}/sysconfig/xencommons %config(noreplace) %{_sysconfdir}/xen/xl.conf %config(noreplace) %{_sysconfdir}/xen/cpupool +%config(noreplace) %{_sysconfdir}/xen/xlexample* # Auto-load xen backend drivers %attr(0755,root,root) %{_sysconfdir}/sysconfig/modules/%{name}.modules @@ -577,6 +587,10 @@ rm -rf %{buildroot} %{_mandir}/man1/xentop.1* %{_mandir}/man1/xentrace_format.1* %{_mandir}/man8/xentrace.8* +%{_mandir}/man1/xl.1* +%{_mandir}/man5/xl.cfg.5* +%{_mandir}/man5/xl.conf.5* +%{_mandir}/man5/xlcpupool.cfg.5* %{python_sitearch}/fsimage.so %{python_sitearch}/grub @@ -591,11 +605,13 @@ rm -rf %{buildroot} /usr/lib/%{name}/bin/stubdom-dm /usr/lib/%{name}/bin/qemu-dm /usr/lib/%{name}/bin/stubdompath.sh +/usr/lib/%{name}/bin/xenpaging %endif %dir /usr/lib/%{name}/boot # HVM loader is always in /usr/lib regardless of multilib /usr/lib/xen/boot/hvmloader /usr/lib/xen/boot/ioemu-stubdom.gz +/usr/lib/xen/boot/xenstore-stubdom.gz /usr/lib/xen/boot/pv-grub*.gz %endif # General Xen state @@ -643,7 +659,6 @@ rm -rf %{buildroot} %{_sbindir}/xenconsoled %{_sbindir}/xenlockprof %{_sbindir}/xenmon.py* -%{_sbindir}/xenpaging %{_sbindir}/xentop %{_sbindir}/xentrace_setmask %{_sbindir}/xenbaked @@ -654,6 +669,8 @@ rm -rf %{buildroot} %{_sbindir}/xenwatchdogd %{_sbindir}/xl %{_sbindir}/xsview +%{_sbindir}/xen-lowmemd +%{_sbindir}/xen-ringwatch # Xen logfiles %dir %attr(0700,root,root) %{_localstatedir}/log/xen @@ -665,6 +682,9 @@ rm -rf %{buildroot} /boot/xen-syms-* /boot/xen-*.gz /boot/xen.gz +%if %build_efi +/boot/efi/EFI/fedora/*.efi +%endif %files doc %defattr(-,root,root) @@ -677,6 +697,8 @@ rm -rf %{buildroot} %{_includedir}/*.h %dir %{_includedir}/xen %{_includedir}/xen/* +%dir %{_includedir}/xenstore-compat +%{_includedir}/xenstore-compat/* %{_libdir}/*.so %files licenses @@ -693,6 +715,7 @@ rm -rf %{buildroot} %{_libdir}/ocaml/stublibs/*.so %{_libdir}/ocaml/stublibs/*.so.owner %{_sbindir}/oxenstored +%config(noreplace) %{_sysconfdir}/xen/oxenstored.conf %files ocaml-devel %defattr(-,root,root) @@ -702,6 +725,22 @@ rm -rf %{buildroot} %endif %changelog +* Thu Oct 25 2012 Michael Young - 4.2.0-1 +- update to xen-4.2.0 +- rebase xen-net-disable-iptables-on-bridge.patch pygrubfix.patch +- remove patches that are now upstream or with alternatives upstream +- use ipxe and seabios from seabios-bin and ipxe-roms-qemu packages +- xen tools now need ./configure to be run (x86_64 needs libdir set) +- don't build upstream qemu version +- amend list of files in package - relocate xenpaging + add /etc/xen/xlexample* oxenstored.conf /usr/include/xenstore-compat/* + xenstore-stubdom.gz xen-lowmemd xen-ringwatch xl.1.gz xl.cfg.5.gz + xl.conf.5.gz xlcpupool.cfg.5.gz +- use a tmpfiles.d file to create /run/xen on boot +- add BuildRequires for yajl-devel and graphviz +- build an efi boot image where it is supported +- adjust texlive changes so spec file still works on Fedora 17 + * Thu Oct 18 2012 Michael Young - 4.1.3-6 - add font packages to build requires due to 2012 version of texlive in F19 - use build requires of texlive-latex instead of tetex-latex which it diff --git a/xen.use.fedora.ipxe.patch b/xen.use.fedora.ipxe.patch new file mode 100644 index 0000000..4588474 --- /dev/null +++ b/xen.use.fedora.ipxe.patch @@ -0,0 +1,33 @@ +--- xen-4.2.0/tools/firmware/hvmloader/Makefile.orig 2012-05-27 21:57:04.481812859 +0100 ++++ xen-4.2.0/tools/firmware/hvmloader/Makefile 2012-06-02 18:52:44.935034128 +0100 +@@ -48,7 +48,7 @@ + else + CIRRUSVGA_ROM := ../vgabios/VGABIOS-lgpl-latest.cirrus.bin + endif +-ETHERBOOT_ROMS := $(addprefix ../etherboot/ipxe/src/bin/, $(addsuffix .rom, $(ETHERBOOT_NICS))) ++ETHERBOOT_ROMS := $(addprefix /usr/share/ipxe/, $(addsuffix .rom, $(ETHERBOOT_NICS))) + endif + + ROMS := +--- xen-4.2.0/Config.mk.orig 2012-05-27 21:57:04.479812884 +0100 ++++ xen-4.2.0/Config.mk 2012-06-02 18:55:14.087169469 +0100 +@@ -206,7 +206,7 @@ + # Sun Mar 11 09:27:07 2012 -0400 + # Update version to 1.6.3.2 + +-ETHERBOOT_NICS ?= rtl8139 8086100e ++ETHERBOOT_NICS ?= 10ec8139 8086100e + + # Specify which qemu-dm to use. This may be `ioemu' to use the old + # Mercurial in-tree version, or a local directory, or a git URL. +--- xen-4.2.0/tools/firmware/Makefile.orig 2012-05-27 21:57:04.480812871 +0100 ++++ xen-4.2.0/tools/firmware/Makefile 2012-06-02 19:03:52.254691484 +0100 +@@ -10,7 +10,7 @@ + #SUBDIRS-$(CONFIG_SEABIOS) += seabios-dir + SUBDIRS-$(CONFIG_ROMBIOS) += rombios + SUBDIRS-$(CONFIG_ROMBIOS) += vgabios +-SUBDIRS-$(CONFIG_ROMBIOS) += etherboot ++#SUBDIRS-$(CONFIG_ROMBIOS) += etherboot + SUBDIRS-y += hvmloader + + ovmf: diff --git a/xen.use.fedora.seabios.patch b/xen.use.fedora.seabios.patch new file mode 100644 index 0000000..86d46aa --- /dev/null +++ b/xen.use.fedora.seabios.patch @@ -0,0 +1,22 @@ +--- xen-4.2.0/tools/firmware/Makefile.orig 2012-05-12 16:40:47.000000000 +0100 ++++ xen-4.2.0/tools/firmware/Makefile 2012-05-27 21:55:23.438076078 +0100 +@@ -7,7 +7,7 @@ + + SUBDIRS-y := + SUBDIRS-$(CONFIG_OVMF) += ovmf +-SUBDIRS-$(CONFIG_SEABIOS) += seabios-dir ++#SUBDIRS-$(CONFIG_SEABIOS) += seabios-dir + SUBDIRS-$(CONFIG_ROMBIOS) += rombios + SUBDIRS-$(CONFIG_ROMBIOS) += vgabios + SUBDIRS-$(CONFIG_ROMBIOS) += etherboot +--- xen-4.2.0/tools/firmware/hvmloader/Makefile.orig 2012-05-12 16:40:47.000000000 +0100 ++++ xen-4.2.0/tools/firmware/hvmloader/Makefile 2012-05-27 21:53:45.625298906 +0100 +@@ -70,7 +70,7 @@ + ifeq ($(CONFIG_SEABIOS),y) + OBJS += seabios.o + CFLAGS += -DENABLE_SEABIOS +-SEABIOS_ROM := $(SEABIOS_DIR)/out/bios.bin ++SEABIOS_ROM := /usr/share/seabios/bios.bin + ROMS += $(SEABIOS_ROM) + endif +