summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2016-06-10 15:21:47 +0900
committerSean Whitton <spwhitton@spwhitton.name>2016-06-10 15:21:47 +0900
commit19b3eb8ff90092748d8718d751d5fd6865b6e7cd (patch)
tree466321e4bf273a01439adda82de94f070b1c329d
parentde50503e4dbdea853e899f01e8828cf4f454dd57 (diff)
parent2cdc8a2eb9a3cf87c3f5ac09ee8c00931a666997 (diff)
Record propellor (3.0.5-1) in archive suite sid
-rw-r--r--.gitignore11
-rw-r--r--LICENSE2
-rw-r--r--Makefile50
-rw-r--r--config-freebsd.hs66
-rw-r--r--config-joey.hs455
-rw-r--r--config-simple.hs46
-rwxr-xr-xcontrib/post-merge-hook44
-rw-r--r--debian/changelog903
-rw-r--r--debian/control159
-rw-r--r--debian/copyright4
-rw-r--r--debian/gbp.conf10
-rw-r--r--debian/libghc-propellor-dev.links1
-rw-r--r--debian/libghc-propellor-dev.lintian-overrides2
-rw-r--r--debian/libghc-propellor-doc.lintian-overrides2
-rw-r--r--debian/libghc-propellor-prof.links1
-rw-r--r--debian/libghc-propellor-prof.lintian-overrides2
-rw-r--r--debian/lintian-overrides0
-rw-r--r--debian/patches/0001-remove-README.Debian-from-propellor.cabal.patch23
-rw-r--r--debian/patches/series1
-rw-r--r--debian/propellor.README.Debian (renamed from debian/README.Debian)0
-rw-r--r--debian/propellor.docs1
-rw-r--r--debian/propellor.links1
-rw-r--r--debian/propellor.lintian-overrides6
-rw-r--r--debian/propellor.manpages1
-rwxr-xr-xdebian/rules19
-rw-r--r--debian/source/format1
-rw-r--r--debian/source/lintian-overrides5
-rw-r--r--debian/source/options1
-rw-r--r--debian/watch5
-rw-r--r--doc/FreeBSD.mdwn10
-rw-r--r--doc/Linux.mdwn9
-rw-r--r--doc/README.mdwn46
-rw-r--r--doc/automated_spins.mdwn127
-rw-r--r--doc/automated_spins/comment_1_1976b145c519b575c1b0454611036055._comment8
-rw-r--r--doc/automated_spins/comment_2_d0b3cfce5e37727f5b17c14d0f4214d2._comment27
-rw-r--r--doc/automated_spins/comment_3_31fee6824f4f22f8f4fc8e77bf8f8d69._comment8
-rw-r--r--doc/automated_spins/comment_4_0e6a73215c72286ef0053b5d762537ab._comment8
-rw-r--r--doc/coding_style.mdwn18
-rw-r--r--doc/coding_style/comment_1_86e860c6ac600b15b8a84cc7de1880cf._comment9
-rw-r--r--doc/coding_style/comment_2_8bc078909d29f6ae13da9cb99fa4325d._comment11
-rw-r--r--doc/components.mdwn36
-rw-r--r--doc/contributing.mdwn4
-rw-r--r--doc/debugging.mdwn7
-rw-r--r--doc/documentation.mdwn15
-rw-r--r--doc/feeds.mdwn4
-rw-r--r--doc/footer/column_a.mdwn12
-rw-r--r--doc/footer/column_b.mdwn3
-rw-r--r--doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file.mdwn34
-rw-r--r--doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_1_932ba6f4e444c99d8d561149d17c8fe7._comment30
-rw-r--r--doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_2_5323336b92d9aef5a9021b924029f3af._comment38
-rw-r--r--doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_3_531c2c5e78fb5c62e54d84231b129dc8._comment11
-rw-r--r--doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_4_54281604c588a7229f9d987e8cdee802._comment16
-rw-r--r--doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key.mdwn23
-rw-r--r--doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_1_a5fdd6df5bcfab832aa1721cad139de8._comment7
-rw-r--r--doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_2_0197951e17a4a47cce74ce6cc4108d50._comment20
-rw-r--r--doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_3_1f6fdf9c03705665b3d7d1a562dfc2e2._comment9
-rw-r--r--doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_4_38e533c398521a2f1e02fde939f753e1._comment35
-rw-r--r--doc/forum/Dry_run_mode.mdwn3
-rw-r--r--doc/forum/Dry_run_mode/comment_1_eb7b8e8b3259b0510e5551bcf1694ad1._comment7
-rw-r--r--doc/forum/Dry_run_mode/comment_2_cb54f6fcc8e69af4eda4abce4ec4ab45._comment10
-rw-r--r--doc/forum/Embedding_configuration_files_using_Template_Haskell.mdwn24
-rw-r--r--doc/forum/Embedding_configuration_files_using_Template_Haskell/comment_1_ae847dfeb6691034adf4a05f3e55a646._comment17
-rw-r--r--doc/forum/Embedding_configuration_files_using_Template_Haskell/comment_2_4d2b5f37e1f6cff806bb270d38c22f98._comment9
-rw-r--r--doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs.mdwn3
-rw-r--r--doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_1_ae5bb6438981259673e07b7185367b43._comment12
-rw-r--r--doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_2_51249fd1eb1d0eb553c229df775fb7ee._comment7
-rw-r--r--doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_3_a1f7f5da5f01df715173294e83af0e10._comment18
-rw-r--r--doc/forum/Fail_to_push_changes_when_merging.mdwn27
-rw-r--r--doc/forum/Fail_to_push_changes_when_merging/comment_1_a44e03cbce4c996e136f917d8e06a7bb._comment12
-rw-r--r--doc/forum/Fail_to_push_changes_when_merging/comment_2_4c8e1d9409b8ecfc465550fbbf5c0708._comment8
-rw-r--r--doc/forum/Fail_to_push_changes_when_merging/comment_3_bdf54ac096c994c33d661b454d89c770._comment13
-rw-r--r--doc/forum/Formatting_struggle_with_Apt.backportSuite.mdwn9
-rw-r--r--doc/forum/Formatting_struggle_with_Apt.backportSuite/comment_1_9d4f41976824ef29381bbd2bbb3eaf39._comment27
-rw-r--r--doc/forum/Formatting_struggle_with_Apt.backportSuite/comment_2_e4d9c8315d20dae1f0fd38c2eea208cb._comment8
-rw-r--r--doc/forum/FreeBSD_Port.mdwn12
-rw-r--r--doc/forum/FreeBSD_Port/comment_1_ecb4253fd0cf4060cf8706c0f633a225._comment8
-rw-r--r--doc/forum/Git_repo_updating.mdwn1
-rw-r--r--doc/forum/Git_repo_updating/comment_1_f601e29b5fb82700b21914f3fb1ef49b._comment17
-rw-r--r--doc/forum/Git_repo_updating/comment_2_d83a481b0a82ed1ad5446010c6b88485._comment8
-rw-r--r--doc/forum/Locales_always_generated.mdwn18
-rw-r--r--doc/forum/Locales_always_generated/comment_1_26e9d3c1ec2ad32d18ee2205254b71b8._comment12
-rw-r--r--doc/forum/Locales_always_generated/comment_2_fcce3726ab696a55abb12367ff5bf36c._comment8
-rw-r--r--doc/forum/Locales_always_generated/comment_3_6415ceae053e84e78140e95f5d8cafbc._comment7
-rw-r--r--doc/forum/Multiple_propellor_repos.mdwn1
-rw-r--r--doc/forum/Multiple_propellor_repos/comment_1_7e67945e0243553b664805825a839490._comment8
-rw-r--r--doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring.mdwn13
-rw-r--r--doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring/comment_1_c9a24f6022fbe9063356df3ddbd767d6._comment16
-rw-r--r--doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring/comment_2_2300ca8616f5bd229bf7b72a6fb96980._comment7
-rw-r--r--doc/forum/PROPELLOR__95__DEBUG_doesn_not_propagate_to_the_host.mdwn9
-rw-r--r--doc/forum/PROPELLOR__95__DEBUG_doesn_not_propagate_to_the_host/comment_1_fee362df05fbdb34c22c99e2e30a4789._comment10
-rw-r--r--doc/forum/Problem_with_cmdProperty_and_rm.mdwn25
-rw-r--r--doc/forum/Problem_with_cmdProperty_and_rm/comment_1_214a68eb381b3da4a967da0a6c55d87b._comment12
-rw-r--r--doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu.mdwn37
-rw-r--r--doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu/comment_1_67f017b92670759083b73a4536183dbc._comment10
-rw-r--r--doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu/comment_2_08aa3d15e6fa9b3fb4c07fc992da4ab0._comment8
-rw-r--r--doc/forum/Propellor_without_superuser_privileges.mdwn3
-rw-r--r--doc/forum/Propellor_without_superuser_privileges/comment_1_021ecbb1b8bd7e26776b49ec75e90d0c._comment26
-rw-r--r--doc/forum/REversable_property_changes.mdwn36
-rw-r--r--doc/forum/REversable_property_changes/comment_1_951cef3c45112f69254118afbc6fa76e._comment11
-rw-r--r--doc/forum/REversable_property_changes/comment_2_bf2e563f302268765733dde0d4f901fc._comment9
-rw-r--r--doc/forum/REversable_property_changes/comment_3_b6e6a50654fcac2f624c43a04e12c4d6._comment24
-rw-r--r--doc/forum/REversable_property_changes/comment_4_80ebeaedce18dea401c0e754309b5c7b._comment11
-rw-r--r--doc/forum/REversable_property_changes/comment_5_4b876eae2404ea107ba65a3c879a4c2a._comment22
-rw-r--r--doc/forum/Script_to_convert_config_files_for_inclusion_in_Propellor_config.mdwn41
-rw-r--r--doc/forum/Script_to_convert_config_files_for_inclusion_in_Propellor_config/comment_1_98a4c56ba162a1e04a5b5649ff39ee3f._comment8
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed..mdwn58
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_1_b0db2468e86d29deac6167363f88cfdc._comment16
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_2_fa080c190da730dfd023e96ca4000b93._comment9
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_3_1beb3b93a20111af8f736a7581b46d6c._comment8
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_4_bc60f392f8a73ac7bc54f5c3a4670590._comment13
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_5_7be9e5912ef4165bf193f65f51b8216b._comment20
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_6_2798a6806afd2d04cf6c7744ad633133._comment13
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_7_dbf3e1aab2a21b796992d959a82b9fc2._comment19
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_8_cf2215bc51ed57558c76beb5226cf5fa._comment26
-rw-r--r--doc/forum/Shared_connection_to_xxx_closed./comment_9_3f3028244efa8a6528a4530bca4cb222._comment11
-rw-r--r--doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user.mdwn1
-rw-r--r--doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user/comment_1_e22d4f2c96564a7f927a83207651be1c._comment8
-rw-r--r--doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user/comment_2_3cd8b6d02f8826f27b41c1ca27817bfe._comment8
-rw-r--r--doc/forum/Supported_OS.mdwn5
-rw-r--r--doc/forum/Supported_OS/comment_1_f324bed708305e2667bd00f80544dd90._comment23
-rw-r--r--doc/forum/Supported_OS/comment_2_4fcaadea6d57e4bf127fd28720e3ba20._comment7
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container.mdwn31
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_1_07ddf79f04240fd7c9911199b5e7ffd4._comment7
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_2_1f3607a766f4a6bd7a297d958a7f1087._comment14
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_3_04262501adfdb4a2448618f91024f5c0._comment15
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_4_5dc1c3ee7f111fcc36c72487b7713854._comment9
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_5_b73901c0aa408d35346c46e523be8c3f._comment7
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_6_3394c1a7a485057fda84dd910e29d90f._comment23
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_7_5a3418e8cc800ceea5988059b6d86aff._comment8
-rw-r--r--doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_8_f0968beaac7e73e192c0d59fe0637c0e._comment7
-rw-r--r--doc/forum/Understanding_changesFile_equation.mdwn15
-rw-r--r--doc/forum/Understanding_changesFile_equation/comment_1_eab28824f8cd1a03bcc16aee4e161643._comment15
-rw-r--r--doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning.mdwn1
-rw-r--r--doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning/comment_1_12cf8bce9f61c98bd35c934806372ada._comment8
-rw-r--r--doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning/comment_2_dd35e93f3b9e0d2e1041674eee1e6fc8._comment7
-rw-r--r--doc/forum/Weird_SSH_issue.mdwn3
-rw-r--r--doc/forum/Weird_SSH_issue/comment_1_8598e38bc60fd25ebecb7b3b09d74940._comment10
-rw-r--r--doc/forum/Weird_SSH_issue/comment_2_5c0bb1b38a92ff17277f514703ce2761._comment8
-rw-r--r--doc/forum/Weird_SSH_issue/comment_3_8347b69df64b737f4e5df854c55d4e92._comment15
-rw-r--r--doc/forum/Weird_SSH_issue/comment_4_2fbb97cb5bca3a0e2835e7667aff7a00._comment22
-rw-r--r--doc/forum/Weird_SSH_issue/comment_5_bfbcb2a81bff6b6432217c72a5e54576._comment12
-rw-r--r--doc/forum/Weird_SSH_issue/comment_6_d6c4f22f48c5f0b6d06e9a155e8e5f69._comment8
-rw-r--r--doc/forum/Weird_SSH_issue/comment_7_77d2d330846c80ed463644860e49f184._comment9
-rw-r--r--doc/forum/Weird_SSH_issue/comment_8_b5ba54711a869076fdf78f81f2f5c70d._comment24
-rw-r--r--doc/forum/Weird_SSH_issue/comment_9_b66bfe7d8414639adc66874d7e94cabf._comment8
-rw-r--r--doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__.mdwn13
-rw-r--r--doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_1_53e13a037e2913699eb2bdd0d032a745._comment10
-rw-r--r--doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_2_a071a094c69451d6f43f3f8e01fff8a3._comment24
-rw-r--r--doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_3_0b24a74ca08b24b6b6d14860b8ab903a._comment11
-rw-r--r--doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_4_b48193efd8c3b3d8d5992e7de0319773._comment8
-rw-r--r--doc/forum/can_not_build_debian_package.mdwn25
-rw-r--r--doc/forum/can_not_build_debian_package/comment_1_8e4c2850f0494b761803c87cafe5b249._comment9
-rw-r--r--doc/forum/chroot_for_sbuild.mdwn14
-rw-r--r--doc/forum/chroot_for_sbuild/comment_10_1eb7755df6ca4324f49908c1d1984c6b._comment9
-rw-r--r--doc/forum/chroot_for_sbuild/comment_1_7612dc49e14e896be8693be87200c7d3._comment25
-rw-r--r--doc/forum/chroot_for_sbuild/comment_2_b287ed52d9c19b6f7e4b48a5a868b703._comment12
-rw-r--r--doc/forum/chroot_for_sbuild/comment_3_bb01c327417848165197405f5f918caf._comment34
-rw-r--r--doc/forum/chroot_for_sbuild/comment_4_141e2f49bc9b04f7ef211394c8410cec._comment25
-rw-r--r--doc/forum/chroot_for_sbuild/comment_5_dec82cad1490a22c3f2fbbaa4edbd9f0._comment44
-rw-r--r--doc/forum/chroot_for_sbuild/comment_6_9a0b4cce3a9cac8504358d6a280c24bb._comment48
-rw-r--r--doc/forum/chroot_for_sbuild/comment_7_c350c4fba2d7e1bdde6e7cc249052c22._comment8
-rw-r--r--doc/forum/chroot_for_sbuild/comment_8_546b34de1ed2d853fb170f944bba307d._comment17
-rw-r--r--doc/forum/chroot_for_sbuild/comment_9_10dae8ccbd9a8b79e4adab2fa403a409._comment10
-rw-r--r--doc/forum/chroot_issue_when_upgrading.mdwn42
-rw-r--r--doc/forum/chroot_issue_when_upgrading/comment_2_be3846f1cf7853beb486afc2077cd8b2._comment29
-rw-r--r--doc/forum/chroot_issue_when_upgrading/comment_2_eea48d51f241651935f695ea1dc7dd87._comment16
-rw-r--r--doc/forum/chroot_issue_when_upgrading/comment_3_f902730900901dccdf2e290a176458f9._comment9
-rw-r--r--doc/forum/chroot_issue_when_upgrading/comment_4_4004abde37eb4bc7d845fb7bba2c635d._comment14
-rw-r--r--doc/forum/chroot_issue_when_upgrading/comment_5_fe9deffb0cd356787fed33a373115f73._comment26
-rw-r--r--doc/forum/chroot_issue_when_upgrading/comment_6_262df826e5bbd0130964e0433fb172f2._comment7
-rw-r--r--doc/forum/chroot_issue_when_upgrading/comment_7_c682c5e99a1e9910771de0589d74657c._comment36
-rw-r--r--doc/forum/chroot_issue_when_upgrading/comment_8_d1c546c6f88035d40eca823d25d67e92._comment21
-rw-r--r--doc/forum/cron_email.mdwn27
-rw-r--r--doc/forum/delete_a_field__63__.mdwn1
-rw-r--r--doc/forum/delete_a_field__63__/comment_1_157b488bf3e360570bd847d750ab0063._comment7
-rw-r--r--doc/forum/functions_that_yield_properties.mdwn21
-rw-r--r--doc/forum/functions_that_yield_properties/comment_1_7de09397627186abda74d765f4194f79._comment29
-rw-r--r--doc/forum/functions_that_yield_properties/comment_2_1abdc8ae6e1a00f02fa0130d845ec236._comment23
-rw-r--r--doc/forum/functions_that_yield_properties/comment_3_76f4a92cf26ae2fcc3152a0f1a19f516._comment17
-rw-r--r--doc/forum/functions_that_yield_properties/comment_4_886daf04a0fa9e6d0dd1e9ef4cc9b63f._comment23
-rw-r--r--doc/forum/gitpush_problem.mdwn68
-rw-r--r--doc/forum/gitpush_problem/comment_1_ba6fb30ea2e2759776351408a3a69b44._comment13
-rw-r--r--doc/forum/gitpush_problem/comment_2_342b7657b964e836840a78b85a09749b._comment8
-rw-r--r--doc/forum/gitpush_problem/comment_3_419baa6f1738200b1368566a2e136d36._comment22
-rw-r--r--doc/forum/gitpush_problem/comment_4_3843d9b82431f175f9194159a73a1fc9._comment13
-rw-r--r--doc/forum/gitpush_problem/comment_5_4075a141f6345267ade09f6c793dc2c8._comment33
-rw-r--r--doc/forum/gitpush_problem/comment_6_464257a98e09dfe17e515242ae819fab._comment11
-rw-r--r--doc/forum/gitpush_problem/comment_7_1cfed50e43cc4ec816999f4f1de79762._comment10
-rw-r--r--doc/forum/gnupg2.mdwn5
-rw-r--r--doc/forum/gnupg2/comment_1_4f07e458eb0c6d124c6c715eea9e20f4._comment13
-rw-r--r--doc/forum/gnupg2/comment_2_9070abc82d8aa259aca187ed5d6638cc._comment12
-rw-r--r--doc/forum/gnupg2/comment_3_996fe5791c175d709217875b5e751c4f._comment7
-rw-r--r--doc/forum/how_to_install_a_cluster_with_propellor.mdwn7
-rw-r--r--doc/forum/how_to_install_a_cluster_with_propellor/comment_1_e6860056989da82fd7cd8f374e209548._comment73
-rw-r--r--doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac.mdwn12
-rw-r--r--doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_1_69d7c8fb1d62300456575bb10e935d69._comment10
-rw-r--r--doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_2_da30b2621493e48ceabcfa5732dbcdf8._comment19
-rw-r--r--doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_3_bd76d169af2ef2f154ad1f0f64506661._comment11
-rw-r--r--doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_4_a6a49d35ee8a05abc982049b55d0397c._comment11
-rw-r--r--doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_5_7783b8a96c8032a39ff3b5b446a976ed._comment7
-rw-r--r--doc/forum/howto_mapM_RevertableProperty.mdwn52
-rw-r--r--doc/forum/howto_mapM_RevertableProperty/comment_1_c2800340a5361add82f5e9e30b56b18c._comment22
-rw-r--r--doc/forum/howto_mapM_RevertableProperty/comment_2_1327f1f218433ce262f871771c43452c._comment23
-rw-r--r--doc/forum/howto_mapM_RevertableProperty/comment_3_7e519cc5f1c07b66561ec31866ddbc8a._comment11
-rw-r--r--doc/forum/mailname_set_by_Propellor.Property.Hostname.sane.mdwn1
-rw-r--r--doc/forum/mailname_set_by_Propellor.Property.Hostname.sane/comment_1_199da2bf7793c33841d21599703a3006._comment15
-rw-r--r--doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__.mdwn177
-rw-r--r--doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_1_8959a79735aa3fa13ee37e57eb5a92e1._comment14
-rw-r--r--doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_2_f07c33b4a14cdc0b78695de49875c9b5._comment52
-rw-r--r--doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_3_06c63446531f56e4c93f64f6bcfba2b1._comment25
-rw-r--r--doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_4_f52f30380b4fe58292fcf0ef368efbb1._comment44
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount.mdwn19
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount/comment_1_8524e66ddfa2d21ae7b70f257984fc2c._comment30
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount/comment_2_90831d9859cfe0c6dafe029584b3deef._comment17
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount/comment_3_a82855697a268a4f2165db717a652516._comment28
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment17
-rw-r--r--doc/forum/parsing_a_config_file.mdwn11
-rw-r--r--doc/forum/parsing_a_config_file/comment_1_8e97fb2e39c1a91bcab75e57ddc8b519._comment12
-rw-r--r--doc/forum/parsing_a_config_file/comment_2_9b364647b1da4c8db0116115e5c67b18._comment13
-rw-r--r--doc/forum/parsing_a_config_file/comment_3_e143e0ebfb1fb631639b692df67ea8e8._comment8
-rw-r--r--doc/forum/passing_host_address_dynamically_to_propellor.mdwn2
-rw-r--r--doc/forum/passing_host_address_dynamically_to_propellor/comment_1_1c5d5b59f2325a2f4e06d09a9900007f._comment25
-rw-r--r--doc/forum/passing_host_address_dynamically_to_propellor/comment_2_b9041877dfc6e6bfb63a014492a2d1d1._comment18
-rw-r--r--doc/forum/passing_host_address_dynamically_to_propellor/comment_3_49d6408ee7618ccb88a537e519f95b27._comment11
-rw-r--r--doc/forum/passing_host_address_dynamically_to_propellor/comment_4_1f208acbe17e25a2b25e1615146d7a0a._comment9
-rw-r--r--doc/forum/passing_host_address_dynamically_to_propellor/comment_5_cd61e6fb0d5694575edb95728f0c8370._comment23
-rw-r--r--doc/forum/problem_with_Tar.mdwn12
-rw-r--r--doc/forum/problem_with_Tar/comment_1_605863f2846dd2e2ccf2516ad54042fb._comment12
-rw-r--r--doc/forum/problem_with_Tar/comment_2_c3a5801b7a22b3b52ed1d2279e725739._comment9
-rw-r--r--doc/forum/propellor_--add-key_fails.mdwn64
-rw-r--r--doc/forum/propellor_--add-key_fails/comment_1_573d07e2387b342a2029c9fc51869040._comment8
-rw-r--r--doc/forum/propellor_2.15.2_does_not_work_on_jessie.mdwn20
-rw-r--r--doc/forum/propellor_2.15.2_does_not_work_on_jessie/comment_1_eafe3affdad32bc9f4493a938f71d83f._comment9
-rw-r--r--doc/forum/propellor_with_no_central_repository__63__/comment_2_0f035bb4bb5cc13574394505f28abe5e._comment9
-rw-r--r--doc/forum/property_combinator_ordering.mdwn8
-rw-r--r--doc/forum/property_combinator_ordering/comment_1_0ea2186b5cfa7eadaf38ac2e97fc4a2c._comment31
-rw-r--r--doc/forum/property_which_create_a_file.mdwn15
-rw-r--r--doc/forum/property_which_create_a_file/comment_1_bc541cd7e3fdaa8e1664e95bebecb2bc._comment14
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs.mdwn6
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_10_f64dc6112a27f5f9a0b6ccf379c7a0e2._comment18
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_11_ac0d07af8234d6adb9b40524f6d5b10b._comment14
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_1_0e46ad1844c37a65c532cafe81fd883a._comment13
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_2_be69a181c1c5212abdc518881f80a199._comment24
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_3_7552ac7f5c97c8c2854305b6f0dd7c6b._comment9
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_4_2fa7a7b10f3a9d2602607ebb8bb48a65._comment38
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_5_3311b66df8a66f304924b329cc71c59b._comment8
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_6_b7c19550ce9a5714bf8953a4134838f1._comment18
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_7_37a683d847bd7275c6ff7b0ad94af6a6._comment8
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_8_b20c69390343bf3b2a7f7b6776f43389._comment12
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_9_2944596b92b437f9c5978cfc1e1bf4fb._comment71
-rw-r--r--doc/forum/reconfigure_package.mdwn15
-rw-r--r--doc/forum/reconfigure_package/comment_1_9dc1f678cf2e4d70c218d9220b0ed320._comment9
-rw-r--r--doc/forum/reconfigure_package/comment_2_840eee135abdf283f788dd7a3615b816._comment11
-rw-r--r--doc/forum/reconfigure_package/comment_3_0d739809f8eeefa1c22f96a7c2d3a522._comment9
-rw-r--r--doc/forum/removing_key.mdwn1
-rw-r--r--doc/forum/removing_key/comment_1_d3771b025fa844c5b6d99d54dd9a2524._comment11
-rw-r--r--doc/forum/removing_key/comment_2_81dfe67885ff21c43894662933e7be7d._comment8
-rw-r--r--doc/forum/running_propellor_as_a_library.mdwn4
-rw-r--r--doc/forum/running_propellor_as_a_library/comment_1_a7b8279508cd68e8cfbba238178a7643._comment49
-rw-r--r--doc/forum/running_propellor_as_a_library/comment_2_1174504655ffaf7ebc507e915cc26c84._comment7
-rw-r--r--doc/forum/running_propellor_as_a_library/comment_3_3e3961587228eb030ff8f704c71b00a5._comment8
-rw-r--r--doc/forum/running_propellor_as_a_library/comment_4_c5ec270ca7cb1b6ae66cd7b9dc4e4aac._comment11
-rw-r--r--doc/forum/running_propellor_as_a_library/comment_5_39c24e955e290f045b8f6d5b9ed9f688._comment36
-rw-r--r--doc/forum/trying_to_--spin_to_a_sid+experimental_machine.mdwn290
-rw-r--r--doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_1_df7ac45d7e576e8d73a8665521dbd6e0._comment29
-rw-r--r--doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_2_8600d257d92f786f2fcf0d4934f727d5._comment17
-rw-r--r--doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_3_f1ca62944fe0303db6f1dc0916e8c967._comment13
-rw-r--r--doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_4_d0d946df7455d079af9bc331da6fac55._comment16
-rw-r--r--doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket.mdwn7
-rw-r--r--doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket/comment_1_9d72cfc76d5ef15de5de54be2567a23e._comment33
-rw-r--r--doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket/comment_2_28706044d9cc744148c6744577afd261._comment12
-rw-r--r--doc/forum/upgrading_to_propellor_3.0.mdwn85
-rw-r--r--doc/forum/upgrading_to_propellor_3.0/comment_1_ddf4b31102bf16a34afaa6f77e8464d1._comment135
-rw-r--r--doc/forum/upgrading_to_propellor_3.0/comment_2_ce961eb3a2a006ecce09eb7f9bd550cf._comment63
-rw-r--r--doc/forum/upgrading_to_propellor_3.0/comment_3_88584d22eb238dc172cb3b4f2f6d30fc._comment8
-rw-r--r--doc/forum/upgrading_to_propellor_3.0/comment_4_71afd4663589c1aad367c071c6cdd24a._comment12
-rw-r--r--doc/haskell_newbie.mdwn43
-rw-r--r--doc/index.mdwn22
-rw-r--r--doc/interface_stability.mdwn6
-rwxr-xr-xdoc/mdwn2man44
-rw-r--r--doc/news.mdwn2
-rw-r--r--doc/news/version_0.8.1.mdwn7
-rw-r--r--doc/news/version_0.8.2.mdwn10
-rw-r--r--doc/news/version_0.8.3.mdwn11
-rw-r--r--doc/news/version_0.9.0.mdwn12
-rw-r--r--doc/news/version_0.9.1.mdwn6
-rw-r--r--doc/news/version_2.15.4.mdwn15
-rw-r--r--doc/news/version_2.16.0.mdwn18
-rw-r--r--doc/news/version_2.17.0.mdwn30
-rw-r--r--doc/news/version_2.17.1.mdwn8
-rw-r--r--doc/news/version_2.17.2.mdwn8
-rw-r--r--doc/news/version_3.0.4.mdwn8
-rw-r--r--doc/posts.mdwn2
-rw-r--r--doc/security.mdwn23
-rw-r--r--doc/security/comment_6_e5f2fdced08fb823efed35684110a840._comment11
-rw-r--r--doc/security/comment_7_ebbb6f3617c879715a35900a07ea1909._comment8
-rw-r--r--doc/security/comment_8_311b80b491ecd018c73631044450294a._comment13
-rw-r--r--doc/templates/bare.tmpl1
-rw-r--r--doc/templates/todolist.tmpl25
-rw-r--r--doc/todo.mdwn11
-rw-r--r--doc/todo/Bug_in_Property.Ssh.authorizedKey.mdwn8
-rw-r--r--doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties.mdwn25
-rw-r--r--doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_1_c8240ba3abf5cf458eba8ed7e31eaccf._comment25
-rw-r--r--doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_2_9303138a3be2fb639498737afe60b87d._comment11
-rw-r--r--doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_3_92c583f883fae2b447c1598356efade2._comment41
-rw-r--r--doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_4_2049a1ce601ba77f4139f844d0fd91b2._comment13
-rw-r--r--doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_5_4caff287eb767d481bb7ef87e62c508b._comment10
-rw-r--r--doc/todo/Fix___40__-__62__-__41___signature_in_Propellor.Types.Container.mdwn4
-rw-r--r--doc/todo/HostingProvider_for_AWS.mdwn1
-rw-r--r--doc/todo/HostingProvider_for_AWS/comment_1_9db50a3f4fef8e10261e3e29dbd90e73._comment22
-rw-r--r--doc/todo/HostingProvider_for_AWS/comment_2_bc4fdd34c10aa3d3846818baf7b07dc7._comment8
-rw-r--r--doc/todo/HostingProvider_for_AWS/comment_3_062f85b8358930759b498b613c5599cd._comment10
-rw-r--r--doc/todo/HostingProvider_for_AWS/comment_4_7fb00a5629b390c658fcf3569d49d2c2._comment8
-rw-r--r--doc/todo/HostingProvider_for_AWS/comment_5_ace17433647f7b2adbce27261cf4cd33._comment14
-rw-r--r--doc/todo/HostingProvider_for_AWS/comment_6_be3608729f362cdf5fc0a338c4a07f67._comment8
-rw-r--r--doc/todo/HostingProvider_for_AWS/comment_7_a77278f07bc0047d1f25c3d6c294b475._comment7
-rw-r--r--doc/todo/License_in_propellor.cabal.mdwn3
-rw-r--r--doc/todo/License_in_propellor.cabal/comment_1_3009093e2ab7bcf9e60555da71796a63._comment10
-rw-r--r--doc/todo/Manage_DNS_with_Route53.mdwn1
-rw-r--r--doc/todo/Manage_DNS_with_Route53/comment_1_dfa93678644b72781afda4fdc9d0da31._comment21
-rw-r--r--doc/todo/Manage_DNS_with_Route53/comment_2_a6c1ace47d5387d0b1559266ca124525._comment8
-rw-r--r--doc/todo/Manage_DNS_with_Route53/comment_3_a521a1b875526d8b65e76f11ed367a36._comment8
-rw-r--r--doc/todo/OpenVPN___40__PR___35__13__41__.mdwn20
-rw-r--r--doc/todo/Propellor.Property.Ssh:_it_should_be_possible_to_call_permitRootLogin_with___34__forced-commands-only__34___and___34__without-password__34__.mdwn5
-rw-r--r--doc/todo/Push_2.4.0_to_Hackage.mdwn4
-rw-r--r--doc/todo/RevertableProperty_with_NoInfo.mdwn48
-rw-r--r--doc/todo/SDN_Configuration.mdwn1
-rw-r--r--doc/todo/User.hasDesktopGroups:_debian-tor_group_doesn__39__t_necessarily_exist.mdwn10
-rw-r--r--doc/todo/Wishlist:_User.hasLoginShell.mdwn9
-rw-r--r--doc/todo/Wishlist:_User.hasLoginShell/comment_1_c02e8783b91c3c0326bf1b317be4694f._comment58
-rw-r--r--doc/todo/bytes_in_privData__63__.mdwn17
-rw-r--r--doc/todo/bytes_in_privData__63__/comment_1_42c107179b091f74ef55aff1fc240c5e._comment19
-rw-r--r--doc/todo/bytes_in_privData__63__/comment_2_60f577b476adc6ee1e4f18e11843df90._comment7
-rw-r--r--doc/todo/bytes_in_privData__63__/comment_3_55f34128de77b7947d32fac71071e033._comment7
-rw-r--r--doc/todo/bytes_in_privData__63__/comment_4_f34a8f82c7bce7224e4edc59410c741f._comment19
-rw-r--r--doc/todo/bytes_in_privData__63__/comment_5_f4db6ffad054feb7eb299708fcd7d05c._comment15
-rw-r--r--doc/todo/bytes_in_privData__63__/comment_6_545e1c26a042b9f8347496a1bfb61548._comment48
-rw-r--r--doc/todo/bytes_in_privData__63__/comment_7_d6c4c2645696eac448e906d812c2de62._comment25
-rw-r--r--doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn9
-rw-r--r--doc/todo/commandline_to_setup_minimal_repo.mdwn7
-rw-r--r--doc/todo/concurrency.mdwn114
-rw-r--r--doc/todo/concurrency/comment_1_0c428752e38798f0e8c8a72457c0a670._comment8
-rw-r--r--doc/todo/concurrency/comment_2_d259eb0ff27327cc94542c9374d3da90._comment8
-rw-r--r--doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn5
-rw-r--r--doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment14
-rw-r--r--doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_2_bd695a2e9ab90b355a71388dc6e7205d._comment7
-rw-r--r--doc/todo/depend_on_concurrent-output.mdwn6
-rw-r--r--doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn15
-rw-r--r--doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_1_892385793c38976d0c446906dd004772._comment10
-rw-r--r--doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_2_c111d137cbaa72b4e6a4c7df3ce2063c._comment31
-rw-r--r--doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_3_40c1c09685acedb2f79726d6175544ab._comment25
-rw-r--r--doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_4_1800ed279466eb210856e0bac8d46962._comment11
-rw-r--r--doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_6_36e0123127b60d1d9e9cf38783dc0c2c._comment9
-rw-r--r--doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_6_73842a5ea0d791cd05621778803e0b69._comment8
-rw-r--r--doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_7_dd93ac4f42dab131aa75fece53e51067._comment16
-rw-r--r--doc/todo/docker_todo_list.mdwn2
-rw-r--r--doc/todo/dynamic_Info.mdwn4
-rw-r--r--doc/todo/editor_for_privdata__63__.mdwn4
-rw-r--r--doc/todo/editor_for_privdata__63__/comment_2_4fcbdf36f32ca7cf82593a8992167aff._comment9
-rw-r--r--doc/todo/fail_if_modification_not_commited_when_using_--spin.mdwn3
-rw-r--r--doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_1_7267d62ccc8db44bccb935836536e8a1._comment30
-rw-r--r--doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_2_e4d170a14d689bef5d9174b251a4fe6f._comment7
-rw-r--r--doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_3_c69eaa9c6ae5b07b5c2dd2591de965a3._comment19
-rw-r--r--doc/todo/git_push_over_propellor_ssh_channel.mdwn2
-rw-r--r--doc/todo/hooks.mdwn5
-rw-r--r--doc/todo/hooks/comment_1_4ca9e46f36d0fae334d9c2f2c211d0e3._comment14
-rw-r--r--doc/todo/info_propigation_out_of_nested_properties.mdwn109
-rw-r--r--doc/todo/integrate_shell-monad.mdwn11
-rw-r--r--doc/todo/issue_after_upgrading_shared_library.mdwn25
-rw-r--r--doc/todo/issue_after_upgrading_shared_library/comment_1_8d9144d57871cb5d234710d1ab1b7183._comment20
-rw-r--r--doc/todo/issue_after_upgrading_shared_library/comment_2_01a3d5e006158302e12862cacee3327e._comment7
-rw-r--r--doc/todo/issue_after_upgrading_shared_library/comment_2_6025ec35330fbac220f2888e60be1e78._comment17
-rw-r--r--doc/todo/lxc_containers_support.mdwn1
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn20
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild/comment_1_b3343283b2d7d49ab70a95d762d0e081._comment25
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild/comment_2_d8afe7b1fd49df5794c9abf2be732f8b._comment58
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild/comment_3_679468488a88f0a3f28ea0be548691a0._comment8
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild/comment_4_bae208f52cb01eeb6d95a06dd4d5466a._comment9
-rw-r--r--doc/todo/merge_request:___96__propellor_--init__96___should_sometimes_run___96__cabal_sandbox_init__96__.mdwn5
-rw-r--r--doc/todo/missing_dependencies.mdwn41
-rw-r--r--doc/todo/missing_dependencies/comment_1_826a75052e87c04489aa07c3d322a54f._comment15
-rw-r--r--doc/todo/multi_gpg_key_privdata.mdwn14
-rw-r--r--doc/todo/onChange_failure_handling.mdwn41
-rw-r--r--doc/todo/privdata_file_split.mdwn27
-rw-r--r--doc/todo/problem_with_spin_after_new_dependencies_added.mdwn48
-rw-r--r--doc/todo/problem_with_spin_after_new_dependencies_added/comment_1_3adbcc7db82f14d10c7efaba889ab009._comment12
-rw-r--r--doc/todo/propellor_--init_option_B_failure.mdwn41
-rw-r--r--doc/todo/propellor_--init_option_B_failure/comment_1_f2229a499f4be0e64d030e2ecc0927f6._comment16
-rw-r--r--doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN.mdwn17
-rw-r--r--doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_1_432c6009fbe2309af81a47658173f753._comment27
-rw-r--r--doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_2_3ddaec3927b4a4aefad45a02e83476dc._comment9
-rw-r--r--doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_3_cf7b9d698c67e7a12d07a53667241092._comment9
-rw-r--r--doc/todo/publish_propellor_as_library_to_hackage.mdwn4
-rw-r--r--doc/todo/publish_propellor_as_library_to_hackage/comment_1_00a865bf7977c0e49f54a365f4b60ce8._comment27
-rw-r--r--doc/todo/publish_propellor_as_library_to_hackage/comment_2_29cc276929020e68eae8ae04110a3f5f._comment17
-rw-r--r--doc/todo/publish_propellor_as_library_to_hackage/comment_3_efbe0ef77be957c37e745ec64452ae99._comment10
-rw-r--r--doc/todo/publish_propellor_as_library_to_hackage/comment_4_6ebf2e30596ddf6eba91717576837019._comment8
-rw-r--r--doc/todo/publish_propellor_as_library_to_hackage/comment_5_4a4e94c637e0380adc1a43ec3d0633e1._comment8
-rw-r--r--doc/todo/publish_propellor_as_library_to_hackage/comment_6_19470170c3ef461f446b0af1d8501640._comment8
-rw-r--r--doc/todo/pull_request:_Git.bareRepoDefaultBranch_property.mdwn7
-rw-r--r--doc/todo/pull_request:_Git.repoConfigured_and_Git.repoAcceptsNonFFs_properties.mdwn13
-rw-r--r--doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties.mdwn15
-rw-r--r--doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties/comment_1_3c528827f40420e3f4001f69127a0c51._comment17
-rw-r--r--doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties/comment_2_981a305c50d699fd3d06c39ca66107ea._comment7
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable.mdwn6
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_10_eb58216ef1172ee5b882090dab7219ce._comment32
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_11_bee4b2397dfb28a3791081a83d725daf._comment7
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_12_1e09f5a3f4565a9392d7b50b703a8a69._comment17
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_13_54de6d1c5351e9303c190edda7e7a33f._comment7
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_1_88f5d79b8cd6064d1a65dec445819afe._comment14
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_2_23cb35130719bf1657652b76c0791947._comment10
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_3_5759b4fddf360e8a777c0339c5426b40._comment9
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_4_cd49645ff94d9ccec74ff72a836cd1f7._comment20
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_5_33744064a8b224d6e44e2cf8081f6a56._comment9
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_6_db48a08bc6eece590aebd41691623665._comment7
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_7_9c45f473cbc432a32bd64bbbf048fae4._comment21
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_8_7069f68888663fef109b82a044aeb5e1._comment9
-rw-r--r--doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_9_5694c0bec217d3513aa8e80f55482d75._comment17
-rw-r--r--doc/todo/pull_request:_reproducible___47__usr__47__src__47__propellor__47__propellor.git.mdwn9
-rw-r--r--doc/todo/pull_request:_reproducible___47__usr__47__src__47__propellor__47__propellor.git/comment_1_d1ed8af3172ada81d166063f0b38e23a._comment11
-rw-r--r--doc/todo/revertable_Ssh.authorizedKey.mdwn3
-rw-r--r--doc/todo/revertable_Ssh.authorizedKey/comment_1_6c11976a814a7f4a830bc11ae9bf534e._comment11
-rw-r--r--doc/todo/revertable_Ssh.authorizedKey/comment_2_5b5c8217eeb48159109b453197694db3._comment8
-rw-r--r--doc/todo/revertable_Ssh.authorizedKey/comment_3_54b1c00246663c845a1b919ccdc168fd._comment7
-rw-r--r--doc/todo/should_not_overwrite_unchanged_private_files.mdwn1
-rw-r--r--doc/todo/should_not_overwrite_unchanged_private_files/comment_1_d65fd2ebfca6b9994db9512232ce78ff._comment20
-rw-r--r--doc/todo/should_not_overwrite_unchanged_private_files/comment_2_2e37e89b8f108f027d2d8c5962a24536._comment9
-rw-r--r--doc/todo/should_not_overwrite_unchanged_private_files/comment_3_5e7127049c1798dfc830d33da0fd78d7._comment8
-rw-r--r--doc/todo/silence_xargs_when_hothasktags_not_installed.mdwn9
-rw-r--r--doc/todo/spin_and_ipv6_addresses.mdwn9
-rw-r--r--doc/todo/spin_without_remote_compilation.mdwn1
-rw-r--r--doc/todo/spin_without_remote_compilation/comment_1_10d797b43df9252c34a02c3fd249374b._comment45
-rw-r--r--doc/todo/spin_without_remote_compilation/comment_2_1c3176559695d33bd7e183b9734e430f._comment8
-rw-r--r--doc/todo/spin_without_remote_compilation/comment_3_3b1053891d1bd9c424f1b517a4686e5d._comment7
-rw-r--r--doc/todo/spin_without_remote_compilation/comment_4_0e98f5ea8af2e14ead239e5b777afb26._comment14
-rw-r--r--doc/todo/ssh__95__user_+_sudo/comment_4_7fc635a8d6e4c903eaefa7383d2c37ac._comment8
-rw-r--r--doc/todo/ssh_hostkey_Info.mdwn2
-rw-r--r--doc/todo/support_tarball_source_images.mdwn5
-rw-r--r--doc/todo/support_tarball_source_images/comment_1_6c019767a6a678d7d9f7ad924e948d94._comment17
-rw-r--r--doc/todo/support_tarball_source_images/comment_2_2d620f837f825f3041d9c66612e2ab4c._comment8
-rw-r--r--doc/todo/support_tarball_source_images/comment_3_411e4884c47fa6c371e6c6d2c5472752._comment8
-rw-r--r--doc/todo/support_tarball_source_images/comment_4_df41bdafff9277fb105ea2da0b0af5d9._comment37
-rw-r--r--doc/todo/support_tarball_source_images/comment_5_fec2c4bf3d0ea806c94b0720b5e80aea._comment8
-rw-r--r--doc/todo/support_tarball_source_images/comment_6_7f06f7f03d943649d24b8c5708bbb952._comment7
-rw-r--r--doc/todo/systemd_unit_integration.mdwn1
-rw-r--r--doc/todo/systemd_unit_integration/comment_1_cc7f255bc8ca5a6e46f0f08889ceac06._comment10
-rw-r--r--doc/todo/type-level_trivial_avoidance.mdwn92
-rw-r--r--doc/todo/type_level_OS_requirements.mdwn56
-rw-r--r--doc/todo/type_level_OS_requirements/comment_10_b0203dee6e00ea956b10ccfdaf3934f7._comment15
-rw-r--r--doc/todo/type_level_OS_requirements/comment_1_507e3b74c2a3b8f41da5d3eddf197c6f._comment75
-rw-r--r--doc/todo/type_level_OS_requirements/comment_2_5a1c0c54db25b039eda28e213e1e6263._comment43
-rw-r--r--doc/todo/type_level_OS_requirements/comment_3_124ceb79eaa4eacc9636147dde4c262c._comment8
-rw-r--r--doc/todo/type_level_OS_requirements/comment_4_8d14bbbec4e219015a80f80bf6124181._comment12
-rw-r--r--doc/todo/type_level_OS_requirements/comment_5_35dbd3a2eb073f4c456ac567aec569bd._comment16
-rw-r--r--doc/todo/type_level_OS_requirements/comment_6_b10cb4445eb2519c8b3f7f080c975113._comment21
-rw-r--r--doc/todo/type_level_OS_requirements/comment_7_6fd5354f19ec624d3eaa1c5eb427ebed._comment39
-rw-r--r--doc/todo/type_level_OS_requirements/comment_7_a760b1a3b62f9bd8fd61eb5ec2ff216f._comment10
-rw-r--r--doc/todo/type_level_OS_requirements/comment_9_8d2153620518295f33b83f1506441fdd._comment23
-rw-r--r--doc/todo/type_level_port_conflict_detection.mdwn84
-rw-r--r--doc/todo/type_level_privdata_availability_checking.mdwn40
-rw-r--r--doc/todo/typo_in_propagate.mdwn6
-rw-r--r--doc/todo/use_ghc_8.0_custom_compile_errors.mdwn27
-rw-r--r--doc/todo/use_stack_for_remote_building_propellor.mdwn3
-rw-r--r--doc/todo/use_stack_for_remote_building_propellor/comment_1_8a97e9ce919fa59f2e36bdd4eb3a7174._comment24
-rw-r--r--doc/todo/use_stack_for_remote_building_propellor/comment_2_71b5434fc2347f680ea5ac75095373ea._comment7
-rw-r--r--doc/todo/use_stack_for_remote_building_propellor/comment_3_93cc19bf7001cf2d3960e71b60db197c._comment10
-rw-r--r--doc/todo/use_stack_for_remote_building_propellor/comment_4_79074734d2837c7678de0010613700a3._comment7
-rw-r--r--doc/todo/use_stack_for_remote_building_propellor/comment_5_10e2bf7ca762b53632dd4fb86f1ce0ae._comment17
-rw-r--r--doc/todo/use_stack_for_remote_building_propellor/comment_6_78d9065109d6c3aa584e1755adc6c6ff._comment8
-rw-r--r--doc/usage.mdwn147
-rw-r--r--doc/user/joey.mdwn1
-rw-r--r--doc/writing_properties.mdwn81
-rw-r--r--joeyconfig.hs636
-rw-r--r--privdata/.joeyconfig/README8
-rw-r--r--privdata/.joeyconfig/keyring.gpgbin0 -> 113014 bytes
-rw-r--r--privdata/.joeyconfig/privdata.gpg1343
-rw-r--r--privdata/privdata.gpg19
-rw-r--r--propellor.115
-rw-r--r--propellor.cabal166
-rw-r--r--src/Propellor.hs83
-rw-r--r--src/Propellor/Base.hs59
-rw-r--r--src/Propellor/Bootstrap.hs229
-rw-r--r--src/Propellor/CmdLine.hs504
-rw-r--r--src/Propellor/Container.hs62
-rw-r--r--src/Propellor/Debug.hs37
-rw-r--r--src/Propellor/DotDir.hs422
-rw-r--r--src/Propellor/Engine.hs91
-rw-r--r--src/Propellor/EnsureProperty.hs70
-rw-r--r--src/Propellor/Exception.hs8
-rw-r--r--src/Propellor/Git.hs28
-rw-r--r--src/Propellor/Git/Config.hs49
-rw-r--r--src/Propellor/Git/VerifiedBranch.hs52
-rw-r--r--src/Propellor/Gpg.hs185
-rw-r--r--src/Propellor/Info.hs150
-rw-r--r--src/Propellor/Location.hs5
-rw-r--r--src/Propellor/Message.hs157
-rw-r--r--src/Propellor/PrivData.hs275
-rw-r--r--src/Propellor/PrivData/Paths.hs31
-rw-r--r--src/Propellor/PropAccum.hs80
-rw-r--r--src/Propellor/Property.hs419
-rw-r--r--src/Propellor/Property/Aiccu.hs54
-rw-r--r--src/Propellor/Property/Apache.hs214
-rw-r--r--src/Propellor/Property/Apt.hs273
-rw-r--r--src/Propellor/Property/Apt/PPA.hs115
-rw-r--r--src/Propellor/Property/Attic.hs149
-rw-r--r--src/Propellor/Property/Borg.hs155
-rw-r--r--src/Propellor/Property/Ccache.hs110
-rw-r--r--src/Propellor/Property/Chroot.hs288
-rw-r--r--src/Propellor/Property/Chroot/Util.hs33
-rw-r--r--src/Propellor/Property/Cmd.hs81
-rw-r--r--src/Propellor/Property/Concurrent.hs135
-rw-r--r--src/Propellor/Property/Conductor.hs337
-rw-r--r--src/Propellor/Property/ConfFile.hs103
-rw-r--r--src/Propellor/Property/Cron.hs69
-rw-r--r--src/Propellor/Property/DebianMirror.hs156
-rw-r--r--src/Propellor/Property/Debootstrap.hs277
-rw-r--r--src/Propellor/Property/DiskImage.hs346
-rw-r--r--src/Propellor/Property/DiskImage/PartSpec.hs81
-rw-r--r--src/Propellor/Property/Dns.hs272
-rw-r--r--src/Propellor/Property/DnsSec.hs122
-rw-r--r--src/Propellor/Property/Docker.hs520
-rw-r--r--src/Propellor/Property/Fail2Ban.hs30
-rw-r--r--src/Propellor/Property/File.hs174
-rw-r--r--src/Propellor/Property/Firewall.hs190
-rw-r--r--src/Propellor/Property/FreeBSD.hs13
-rw-r--r--src/Propellor/Property/FreeBSD/Pkg.hs88
-rw-r--r--src/Propellor/Property/FreeBSD/Poudriere.hs144
-rw-r--r--src/Propellor/Property/Fstab.hs111
-rw-r--r--src/Propellor/Property/Git.hs114
-rw-r--r--src/Propellor/Property/Gpg.hs65
-rw-r--r--src/Propellor/Property/Group.hs14
-rw-r--r--src/Propellor/Property/Grub.hs72
-rw-r--r--src/Propellor/Property/HostingProvider/CloudAtCost.hs35
-rw-r--r--src/Propellor/Property/HostingProvider/DigitalOcean.hs50
-rw-r--r--src/Propellor/Property/HostingProvider/Linode.hs16
-rw-r--r--src/Propellor/Property/Hostname.hs105
-rw-r--r--src/Propellor/Property/Journald.hs55
-rw-r--r--src/Propellor/Property/Kerberos.hs95
-rw-r--r--src/Propellor/Property/LetsEncrypt.hs109
-rw-r--r--src/Propellor/Property/LightDM.hs16
-rw-r--r--src/Propellor/Property/List.hs59
-rw-r--r--src/Propellor/Property/Locale.hs83
-rw-r--r--src/Propellor/Property/Logcheck.hs36
-rw-r--r--src/Propellor/Property/Mount.hs127
-rw-r--r--src/Propellor/Property/Munin.hs56
-rw-r--r--src/Propellor/Property/Network.hs128
-rw-r--r--src/Propellor/Property/Nginx.hs35
-rw-r--r--src/Propellor/Property/OS.hs253
-rw-r--r--src/Propellor/Property/Obnam.hs176
-rw-r--r--src/Propellor/Property/OpenId.hs46
-rw-r--r--src/Propellor/Property/Parted.hs203
-rw-r--r--src/Propellor/Property/Partition.hs91
-rw-r--r--src/Propellor/Property/Postfix.hs254
-rw-r--r--src/Propellor/Property/PropellorRepo.hs19
-rw-r--r--src/Propellor/Property/Prosody.hs51
-rw-r--r--src/Propellor/Property/Reboot.hs29
-rw-r--r--src/Propellor/Property/Rsync.hs62
-rw-r--r--src/Propellor/Property/Sbuild.hs383
-rw-r--r--src/Propellor/Property/Scheduled.hs19
-rw-r--r--src/Propellor/Property/Schroot.hs42
-rw-r--r--src/Propellor/Property/Service.hs30
-rw-r--r--src/Propellor/Property/SiteSpecific/Branchable.hs68
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs275
-rw-r--r--src/Propellor/Property/SiteSpecific/GitHome.hs20
-rw-r--r--src/Propellor/Property/SiteSpecific/IABak.hs121
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs856
-rw-r--r--src/Propellor/Property/Ssh.hs478
-rw-r--r--src/Propellor/Property/Sudo.hs15
-rw-r--r--src/Propellor/Property/Systemd.hs473
-rw-r--r--src/Propellor/Property/Systemd/Core.hs10
-rw-r--r--src/Propellor/Property/Tor.hs190
-rw-r--r--src/Propellor/Property/Unbound.hs142
-rw-r--r--src/Propellor/Property/User.hs221
-rw-r--r--src/Propellor/Property/Uwsgi.hs49
-rw-r--r--src/Propellor/Property/ZFS.hs11
-rw-r--r--src/Propellor/Property/ZFS/Process.hs32
-rw-r--r--src/Propellor/Property/ZFS/Properties.hs40
-rw-r--r--src/Propellor/Protocol.hs72
-rw-r--r--src/Propellor/Shim.hs (renamed from src/Propellor/Property/Docker/Shim.hs)53
-rw-r--r--src/Propellor/SimpleSh.hs101
-rw-r--r--src/Propellor/Spin.hs390
-rw-r--r--src/Propellor/Ssh.hs79
-rw-r--r--src/Propellor/Types.hs308
-rw-r--r--src/Propellor/Types/Chroot.hs47
-rw-r--r--src/Propellor/Types/CmdLine.hs31
-rw-r--r--src/Propellor/Types/Container.hs30
-rw-r--r--src/Propellor/Types/Core.hs106
-rw-r--r--src/Propellor/Types/Dns.hs71
-rw-r--r--src/Propellor/Types/Docker.hs37
-rw-r--r--src/Propellor/Types/Empty.hs16
-rw-r--r--src/Propellor/Types/Info.hs154
-rw-r--r--src/Propellor/Types/MetaTypes.hs213
-rw-r--r--src/Propellor/Types/OS.hs86
-rw-r--r--src/Propellor/Types/PrivData.hs116
-rw-r--r--src/Propellor/Types/Result.hs38
-rw-r--r--src/Propellor/Types/ResultCheck.hs85
-rw-r--r--src/Propellor/Types/Singletons.hs49
-rw-r--r--src/Propellor/Types/ZFS.hs134
-rw-r--r--src/Propellor/Utilities.hs27
-rw-r--r--src/System/Console/Concurrent.hs44
-rw-r--r--src/System/Console/Concurrent/Internal.hs546
-rw-r--r--src/System/Process/Concurrent.hs34
-rw-r--r--src/Utility/Applicative.hs2
-rw-r--r--src/Utility/Data.hs4
-rw-r--r--src/Utility/DataUnits.hs162
-rw-r--r--src/Utility/Directory.hs148
-rw-r--r--src/Utility/Env.hs33
-rw-r--r--src/Utility/Exception.hs92
-rw-r--r--src/Utility/FileMode.hs46
-rw-r--r--src/Utility/FileSystemEncoding.hs50
-rw-r--r--src/Utility/HumanNumber.hs21
-rw-r--r--src/Utility/LinuxMkLibs.hs21
-rw-r--r--src/Utility/Misc.hs14
-rw-r--r--src/Utility/Monad.hs4
-rw-r--r--src/Utility/PartialPrelude.hs2
-rw-r--r--src/Utility/Path.hs127
-rw-r--r--src/Utility/PosixFiles.hs13
-rw-r--r--src/Utility/Process.hs222
-rw-r--r--src/Utility/Process/NonConcurrent.hs35
-rw-r--r--src/Utility/Process/Shim.hs4
-rw-r--r--src/Utility/QuickCheck.hs52
-rw-r--r--src/Utility/SafeCommand.hs118
-rw-r--r--src/Utility/Scheduled.hs67
-rw-r--r--src/Utility/SystemDirectory.hs16
-rw-r--r--src/Utility/Table.hs15
-rw-r--r--src/Utility/ThreadScheduler.hs5
-rw-r--r--src/Utility/Tmp.hs96
-rw-r--r--src/Utility/UserInfo.hs30
-rw-r--r--src/wrapper.hs172
-rw-r--r--stack.yaml3
630 files changed, 26452 insertions, 3863 deletions
diff --git a/.gitignore b/.gitignore
index e9925509..d9285db3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,5 @@
+/propellor
dist/*
-propellor
tags
privdata/local
privdata/keyring.gpg~
@@ -7,3 +7,12 @@ Setup
Setup.hi
Setup.o
docker
+chroot
+propellor.1
+.lock
+.lastchecked
+.stack-work/*
+.cabal-sandbox/
+.dir-locals.el
+cabal.sandbox.config
+*~
diff --git a/LICENSE b/LICENSE
index 712c4586..7b6eea7d 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright 2014 Joey Hess <joeyh@debian.org> and contributors.
+Copyright 2014 Joey Hess <id@joeyh.name> and contributors.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
diff --git a/Makefile b/Makefile
index 9185099c..a9ad2b84 100644
--- a/Makefile
+++ b/Makefile
@@ -1,24 +1,15 @@
CABAL?=cabal
+DATE := $(shell dpkg-parsechangelog 2>/dev/null | grep Date | cut -d " " -f2-)
-DEBDEPS=gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev libghc-quickcheck2-dev libghc-mtl-dev libghc-monadcatchio-transformers-dev
-
-run: deps build
+# this target is provided (and is first) to keep old versions of the
+# propellor cron job working, and will eventually be removed
+run: build
./propellor
-dev: build tags
-
-build: dist/setup-config
- if ! $(CABAL) build; then $(CABAL) configure; $(CABAL) build; fi
+build: tags propellor.1 dist/setup-config
+ $(CABAL) build
ln -sf dist/build/propellor-config/propellor-config propellor
-deps:
- @if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install $(DEBDEPS) || (apt-get update && apt-get --no-upgrade --no-install-recommends -y install $(DEBDEPS)); fi || true
- @if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev || (cabal update; cabal install async); fi || true
-
-dist/setup-config: propellor.cabal
- if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi
- $(CABAL) configure
-
install:
install -d $(DESTDIR)/usr/bin $(DESTDIR)/usr/src/propellor
install -s dist/build/propellor/propellor $(DESTDIR)/usr/bin/propellor
@@ -27,15 +18,23 @@ install:
cat dist/propellor-*.tar.gz | (cd dist/gittmp && tar zx --strip-components=1)
# cabal sdist does not preserve symlinks, so copy over file
cd dist/gittmp && for f in $$(find -type f); do rm -f $$f; cp -a ../../$$f $$f; done
- cd dist/gittmp && git init && \
- git add . \
- && git commit -q -m "distributed version of propellor" \
- && git bundle create $(DESTDIR)/usr/src/propellor/propellor.git master HEAD \
- && git show-ref master --hash > $(DESTDIR)/usr/src/propellor/head
+ # reset mtime on files in git bundle so bundle is reproducible
+ find dist/gittmp -print0 | xargs -0r touch --no-dereference --date="$(DATE)"
+ export GIT_AUTHOR_NAME=build \
+ && export GIT_AUTHOR_EMAIL=build@buildhost \
+ && export GIT_AUTHOR_DATE="$(DATE)" \
+ && export GIT_COMMITTER_NAME=build \
+ && export GIT_COMMITTER_EMAIL=build@buildhost \
+ && export GIT_COMMITTER_DATE="$(DATE)" \
+ && cd dist/gittmp && git init \
+ && git add . \
+ && git commit -q -m "distributed version of propellor" \
+ && git bundle create $(DESTDIR)/usr/src/propellor/propellor.git master HEAD \
+ && git show-ref master --hash > $(DESTDIR)/usr/src/propellor/head
rm -rf dist/gittmp
clean:
- rm -rf dist Setup tags propellor privdata/local
+ rm -rf dist Setup tags propellor propellor.1 privdata/local
find -name \*.o -exec rm {} \;
find -name \*.hi -exec rm {} \;
@@ -43,7 +42,14 @@ clean:
# duplicate tags with Propellor.Property. removed from the start, as we
# often import qualified by just the module base name.
tags:
- find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags | perl -ne 'print; s/Propellor\.Property\.//; print' | sort > tags 2>/dev/null
+ find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags 2>/dev/null | perl -ne 'print; s/Propellor\.Property\.//; print' | sort > tags || true
+
+dist/setup-config: propellor.cabal
+ @if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi
+ @$(CABAL) configure
+
+propellor.1: doc/usage.mdwn doc/mdwn2man
+ doc/mdwn2man propellor 1 < doc/usage.mdwn > propellor.1
# Upload to hackage.
hackage:
diff --git a/config-freebsd.hs b/config-freebsd.hs
new file mode 100644
index 00000000..3ee3f27c
--- /dev/null
+++ b/config-freebsd.hs
@@ -0,0 +1,66 @@
+-- This is the main configuration file for Propellor, and is used to build
+-- the propellor program.
+--
+-- This shows how to set up a FreeBSD host (and a Linux host too).
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Network as Network
+import qualified Propellor.Property.Cron as Cron
+import Propellor.Property.Scheduled
+import qualified Propellor.Property.User as User
+import qualified Propellor.Property.Docker as Docker
+import qualified Propellor.Property.FreeBSD.Pkg as Pkg
+import qualified Propellor.Property.ZFS as ZFS
+import qualified Propellor.Property.FreeBSD.Poudriere as Poudriere
+
+main :: IO ()
+main = defaultMain hosts
+
+-- The hosts propellor knows about.
+hosts :: [Host]
+hosts =
+ [ freebsdbox
+ , linuxbox
+ ]
+
+-- An example freebsd host.
+freebsdbox :: Host
+freebsdbox = host "freebsdbox.example.com" $ props
+ & osFreeBSD (FBSDProduction FBSD102) "amd64"
+ & Pkg.update
+ & Pkg.upgrade
+ & Poudriere.poudriere poudriereZFS
+ & Poudriere.jail (Poudriere.Jail "formail" (fromString "10.2-RELEASE") (fromString "amd64"))
+
+poudriereZFS :: Poudriere.Poudriere
+poudriereZFS = Poudriere.defaultConfig
+ { Poudriere._zfs = Just $ Poudriere.PoudriereZFS
+ (ZFS.ZFS (fromString "zroot") (fromString "poudriere"))
+ (ZFS.fromList [ZFS.Mountpoint (fromString "/poudriere"), ZFS.ACLInherit ZFS.AIPassthrough])
+ }
+
+-- An example linux host.
+linuxbox :: Host
+linuxbox = host "linuxbox.example.com" $ props
+ & osDebian Unstable "amd64"
+ & Apt.stdSourcesList
+ & Apt.unattendedUpgrades
+ & Apt.installed ["etckeeper"]
+ & Apt.installed ["ssh"]
+ & User.hasSomePassword (User "root")
+ & Network.ipv6to4
+ & File.dirExists "/var/www"
+ & Docker.docked webserverContainer
+ & Docker.garbageCollected `period` Daily
+ & Cron.runPropellor (Cron.Times "30 * * * *")
+
+-- A generic webserver in a Docker container.
+webserverContainer :: Docker.Container
+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props
+ & osDebian (Stable "jessie") "amd64"
+ & Apt.stdSourcesList
+ & Docker.publish "80:80"
+ & Docker.volume "/var/www:/var/www"
+ & Apt.serviceInstalledRunning "apache2"
diff --git a/config-joey.hs b/config-joey.hs
deleted file mode 100644
index 74647df9..00000000
--- a/config-joey.hs
+++ /dev/null
@@ -1,455 +0,0 @@
--- This is the live config file used by propellor's author.
--- https://propellor.branchable.com/
-module Main where
-
-import Propellor
-import Propellor.CmdLine
-import Propellor.Property.Scheduled
-import qualified Propellor.Property.File as File
-import qualified Propellor.Property.Apt as Apt
-import qualified Propellor.Property.Network as Network
-import qualified Propellor.Property.Service as Service
-import qualified Propellor.Property.Ssh as Ssh
-import qualified Propellor.Property.Gpg as Gpg
-import qualified Propellor.Property.Cron as Cron
-import qualified Propellor.Property.Sudo as Sudo
-import qualified Propellor.Property.User as User
-import qualified Propellor.Property.Hostname as Hostname
-import qualified Propellor.Property.Tor as Tor
-import qualified Propellor.Property.Dns as Dns
-import qualified Propellor.Property.OpenId as OpenId
-import qualified Propellor.Property.Docker as Docker
-import qualified Propellor.Property.Git as Git
-import qualified Propellor.Property.Apache as Apache
-import qualified Propellor.Property.Postfix as Postfix
-import qualified Propellor.Property.Grub as Grub
-import qualified Propellor.Property.Obnam as Obnam
-import qualified Propellor.Property.HostingProvider.DigitalOcean as DigitalOcean
-import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost
-import qualified Propellor.Property.HostingProvider.Linode as Linode
-import qualified Propellor.Property.SiteSpecific.GitHome as GitHome
-import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
-import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
-
-
-main :: IO () -- _ ______`| ,-.__
-main = defaultMain hosts -- / \___-=O`/|O`/__| (____.'
- {- Propellor -- \ / | / ) _.-"-._
- Deployed -} -- `/-==__ _/__|/__=-| ( \_
-hosts :: [Host] -- * \ | | '--------'
-hosts = -- (o) `
- [ darkstar
- , clam
- , orca
- , kite
- , diatom
- , elephant
- ] ++ containers ++ monsters
-
-darkstar :: Host
-darkstar = host "darkstar.kitenet.net"
- & ipv6 "2001:4830:1600:187::2" -- sixxs tunnel
-
- & Apt.buildDep ["git-annex"] `period` Daily
- & Docker.configured
- ! Docker.docked hosts "android-git-annex"
-
-clam :: Host
-clam = standardSystem "clam.kitenet.net" Unstable "amd64"
- [ "Unreliable server. Anything here may be lost at any time!" ]
- & ipv4 "162.248.9.29"
-
- & CloudAtCost.decruft
- & Apt.unattendedUpgrades
- & Network.ipv6to4
- & Tor.isBridge
- & Postfix.satellite
-
- & Docker.configured
- & Docker.garbageCollected `period` Daily
- & Docker.docked hosts "webserver"
- & File.dirExists "/var/www/html"
- & File.notPresent "/var/www/html/index.html"
- & "/var/www/index.html" `File.hasContent` ["hello, world"]
- & alias "helloworld.kitenet.net"
-
- -- ssh on some extra ports to deal with horrible networks
- -- while travelling
- & alias "travelling.kitenet.net"
- ! Ssh.listenPort 80
- ! Ssh.listenPort 443
-
-orca :: Host
-orca = standardSystem "orca.kitenet.net" Unstable "amd64"
- [ "Main git-annex build box." ]
- & ipv4 "138.38.108.179"
-
- & Apt.unattendedUpgrades
- & Postfix.satellite
- & Docker.configured
- & Docker.docked hosts "amd64-git-annex-builder"
- & Docker.docked hosts "i386-git-annex-builder"
- & Docker.docked hosts "android-git-annex-builder"
- & Docker.docked hosts "armel-git-annex-builder-companion"
- & Docker.docked hosts "armel-git-annex-builder"
- & Docker.garbageCollected `period` Daily
- & Apt.buildDep ["git-annex"] `period` Daily
-
--- This is not a complete description of kite, since it's a
--- multiuser system with eg, user passwords that are not deployed
--- with propellor.
-kite :: Host
-kite = standardSystemUnhardened "kite.kitenet.net" Unstable "amd64"
- [ "Welcome to the new kitenet.net server!"
- ]
- & ipv4 "66.228.36.95"
- & ipv6 "2600:3c03::f03c:91ff:fe73:b0d2"
- & alias "kitenet.net"
- & alias "wren.kitenet.net" -- temporary
-
- & Apt.installed ["linux-image-amd64"]
- & Linode.chainPVGrub 5
- & Apt.unattendedUpgrades
- & Apt.installed ["systemd"]
- & Ssh.hostKeys (Context "kitenet.net")
- & Ssh.passwordAuthentication True
- -- Since ssh password authentication is allowed:
- & Apt.serviceInstalledRunning "fail2ban"
- & Obnam.backup "/" "33 1 * * *"
- [ "--repository=sftp://joey@eubackup.kitenet.net/~/lib/backup/kite.obnam"
- , "--client-name=kitenet.net"
- , "--encrypt-with=98147487"
- , "--exclude=/var/cache"
- , "--exclude=/var/tmp"
- , "--exclude=/home/joey/lib"
- , "--exclude=.*/tmp/"
- , "--one-file-system"
- ] Obnam.OnlyClient
- `requires` Gpg.keyImported "98147487" "root"
- `requires` Ssh.keyImported SshRsa "root"
- (Context "kite.kitenet.net")
- `requires` Ssh.knownHost hosts "eubackup.kitenet.net" "root"
- & Apt.serviceInstalledRunning "ntp"
- & "/etc/timezone" `File.hasContent` ["US/Eastern"]
-
- & alias "smtp.kitenet.net"
- & alias "imap.kitenet.net"
- & alias "pop.kitenet.net"
- & alias "mail.kitenet.net"
- & JoeySites.kiteMailServer
-
- & JoeySites.legacyWebSites
-
- & alias "bitlbee.kitenet.net"
- & Apt.serviceInstalledRunning "bitlbee"
- & "/etc/bitlbee/bitlbee.conf" `File.hasContent`
- [ "[settings]"
- , "User = bitlbee"
- , "AuthMode = Registered"
- , "[defaults]"
- ]
- `onChange` Service.restarted "bitlbee"
- & "/etc/default/bitlbee" `File.containsLine` "BITLBEE_PORT=\"6767\""
- `onChange` Service.restarted "bitlbee"
-
- & Apt.installed
- ["git-annex", "myrepos"
- , "build-essential", "make"
- , "rss2email", "archivemail"
- , "devscripts"
- -- Some users have zsh as their login shell.
- , "zsh"
- ]
-
- & Docker.configured
- & Docker.garbageCollected `period` Daily
-
-diatom :: Host
-diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64"
- [ "Important stuff that needs not too much memory or CPU." ]
- & ipv4 "107.170.31.195"
-
- & DigitalOcean.distroKernel
- & Ssh.hostKeys (Context "diatom.kitenet.net")
- & Apt.unattendedUpgrades
- & Apt.serviceInstalledRunning "ntp"
- & Postfix.satellite
-
- -- Diatom has 500 mb of memory, so tune for that.
- & JoeySites.obnamLowMem
- & Apt.serviceInstalledRunning "swapspace"
-
- & Apt.serviceInstalledRunning "apache2"
- & JoeySites.kitenetHttps
- & Apache.multiSSL
- & File.ownerGroup "/srv/web" "joey" "joey"
- & Apt.installed ["analog"]
-
- & alias "git.kitenet.net"
- & alias "git.joeyh.name"
- & JoeySites.gitServer hosts
-
- & alias "downloads.kitenet.net"
- & JoeySites.annexWebSite "/srv/git/downloads.git"
- "downloads.kitenet.net"
- "840760dc-08f0-11e2-8c61-576b7e66acfd"
- [("usbackup", "ssh://usbackup.kitenet.net/~/lib/downloads/")]
- `requires` Ssh.keyImported SshRsa "joey" (Context "downloads.kitenet.net")
- `requires` Ssh.knownHost hosts "usbackup.kitenet.net" "joey"
- & JoeySites.gitAnnexDistributor
- & alias "tmp.kitenet.net"
- & JoeySites.annexWebSite "/srv/git/joey/tmp.git"
- "tmp.kitenet.net"
- "26fd6e38-1226-11e2-a75f-ff007033bdba"
- []
- & JoeySites.twitRss
- & JoeySites.pumpRss
-
- & alias "nntp.olduse.net"
- & alias "resources.olduse.net"
- & JoeySites.oldUseNetServer hosts
-
- & alias "ns2.kitenet.net"
- & myDnsPrimary "kitenet.net" []
- & myDnsPrimary "joeyh.name" []
- & myDnsPrimary "ikiwiki.info" []
- & myDnsPrimary "olduse.net"
- [ (RelDomain "article",
- CNAME $ AbsDomain "virgil.koldfront.dk") ]
-
- & alias "ns3.branchable.com"
- & branchableSecondary
-
- & Dns.secondaryFor ["animx"] hosts "animx.eu.org"
-
-elephant :: Host
-elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
- [ "Storage, big data, and backups, omnomnom!"
- , "(Encrypt all data stored here.)"
- ]
- & ipv4 "193.234.225.114"
- & Grub.chainPVGrub "hd0,0" "xen/xvda1" 30
- & Postfix.satellite
- & Apt.unattendedUpgrades
- & Ssh.hostKeys ctx
- & sshPubKey "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAJkoPRhUGT8EId6m37uBdYEtq42VNwslKnc9mmO+89ody066q6seHKeFY6ImfwjcyIjM30RTzEwftuVNQnbEB0="
- & Ssh.keyImported SshRsa "joey" ctx
- & Apt.serviceInstalledRunning "swapspace"
- & alias "eubackup.kitenet.net"
- & Apt.installed ["obnam", "sshfs", "rsync"]
- & JoeySites.obnamRepos ["wren", "pell", "kite"]
- & JoeySites.githubBackup
- & JoeySites.rsyncNetBackup hosts
- & JoeySites.backupsBackedupTo hosts "usbackup.kitenet.net" "lib/backup/eubackup"
- & alias "podcatcher.kitenet.net"
- & JoeySites.podcatcher
-
- & alias "znc.kitenet.net"
- & JoeySites.ircBouncer
- -- I'd rather this were on diatom, but it needs unstable.
- & alias "kgb.kitenet.net"
- & JoeySites.kgbServer
- & alias "mumble.kitenet.net"
- & JoeySites.mumbleServer hosts
-
- & alias "ns3.kitenet.net"
- & myDnsSecondary
-
- & Docker.configured
- & Docker.docked hosts "oldusenet-shellbox"
- & Docker.docked hosts "openid-provider"
- `requires` Apt.serviceInstalledRunning "ntp"
- & Docker.docked hosts "ancient-kitenet"
-
- & Docker.garbageCollected `period` (Weekly (Just 1))
-
- -- For https port 443, shellinabox with ssh login to
- -- kitenet.net
- & alias "shell.kitenet.net"
- & JoeySites.kiteShellBox
- -- Nothing is using http port 80, so listen on
- -- that port for ssh, for traveling on bad networks that
- -- block 22.
- & Ssh.listenPort 80
- where
- ctx = Context "elephant.kitenet.net"
-
-
- --' __|II| ,.
- ---- __|II|II|__ ( \_,/\
- ------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'-
- ----------------------- | [Docker] / ----------------------
- ----------------------- : / -----------------------
- ------------------------ \____, o ,' ------------------------
- ------------------------- '--,___________,' -------------------------
-containers :: [Host]
-containers =
- -- Simple web server, publishing the outside host's /var/www
- [ standardStableContainer "webserver"
- & Docker.publish "80:80"
- & Docker.volume "/var/www:/var/www"
- & Apt.serviceInstalledRunning "apache2"
-
- -- My own openid provider. Uses php, so containerized for security
- -- and administrative sanity.
- , standardStableContainer "openid-provider"
- & alias "openid.kitenet.net"
- & Docker.publish "8081:80"
- & OpenId.providerFor ["joey", "liw"]
- "openid.kitenet.net:8081"
-
- -- Exhibit: kite's 90's website.
- , standardStableContainer "ancient-kitenet"
- & alias "ancient.kitenet.net"
- & Docker.publish "1994:80"
- & Apt.serviceInstalledRunning "apache2"
- & Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www"
- (Just "remotes/origin/old-kitenet.net")
-
- , standardStableContainer "oldusenet-shellbox"
- & alias "shell.olduse.net"
- & Docker.publish "4200:4200"
- & JoeySites.oldUseNetShellBox
-
- -- git-annex autobuilder containers
- , GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h"
- , GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h"
- , GitAnnexBuilder.armelCompanionContainer dockerImage
- , GitAnnexBuilder.armelAutoBuilderContainer dockerImage "1 3 * * *" "5h"
- , GitAnnexBuilder.androidAutoBuilderContainer dockerImage "1 1 * * *" "3h"
-
- -- for development of git-annex for android, using my git-annex
- -- work tree
- , let gitannexdir = GitAnnexBuilder.homedir </> "git-annex"
- in GitAnnexBuilder.androidContainer dockerImage "android-git-annex" doNothing gitannexdir
- & Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir)
- ]
-
-type Motd = [String]
-
--- This is my standard system setup.
-standardSystem :: HostName -> DebianSuite -> Architecture -> Motd -> Host
-standardSystem hn suite arch motd = standardSystemUnhardened hn suite arch motd
- -- Harden the system, but only once root's authorized_keys
- -- is safely in place.
- & check (Ssh.hasAuthorizedKeys "root")
- (Ssh.passwordAuthentication False)
-
-standardSystemUnhardened :: HostName -> DebianSuite -> Architecture -> Motd -> Host
-standardSystemUnhardened hn suite arch motd = host hn
- & os (System (Debian suite) arch)
- & Hostname.sane
- & Hostname.searchDomain
- & File.hasContent "/etc/motd" ("":motd++[""])
- & Apt.stdSourcesList `onChange` Apt.upgrade
- & Apt.cacheCleaned
- & Apt.installed ["etckeeper"]
- & Apt.installed ["ssh"]
- & GitHome.installedFor "root"
- & User.hasSomePassword "root" (Context hn)
- & User.accountFor "joey"
- & User.hasSomePassword "joey" (Context hn)
- & Sudo.enabledFor "joey"
- & GitHome.installedFor "joey"
- & Apt.installed ["vim", "screen", "less"]
- & Cron.runPropellor "30 * * * *"
- -- I use postfix, or no MTA.
- & Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]
- `onChange` Apt.autoRemove
-
-standardStableContainer :: Docker.ContainerName -> Host
-standardStableContainer name = standardContainer name (Stable "wheezy") "amd64"
-
--- This is my standard container setup, featuring automatic upgrades.
-standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Host
-standardContainer name suite arch = Docker.container name (dockerImage system)
- & os system
- & Apt.stdSourcesList `onChange` Apt.upgrade
- & Apt.unattendedUpgrades
- & Apt.cacheCleaned
- & Docker.tweaked
- where
- system = System (Debian suite) arch
-
--- Docker images I prefer to use.
-dockerImage :: System -> Docker.Image
-dockerImage (System (Debian Unstable) arch) = "joeyh/debian-unstable-" ++ arch
-dockerImage (System (Debian Testing) arch) = "joeyh/debian-unstable-" ++ arch
-dockerImage (System (Debian (Stable _)) arch) = "joeyh/debian-stable-" ++ arch
-dockerImage _ = "debian-stable-official" -- does not currently exist!
-
-myDnsSecondary :: Property
-myDnsSecondary = propertyList "dns secondary for all my domains" $ map toProp
- [ Dns.secondary hosts "kitenet.net"
- , Dns.secondary hosts "joeyh.name"
- , Dns.secondary hosts "ikiwiki.info"
- , Dns.secondary hosts "olduse.net"
- ]
-
-branchableSecondary :: RevertableProperty
-branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"
-
--- Currently using diatom (ns2) as primary with secondaries
--- elephant (ns3) and gandi.
--- kite handles all mail.
-myDnsPrimary :: Domain -> [(BindDomain, Record)] -> RevertableProperty
-myDnsPrimary domain extras = Dns.primary hosts domain
- (Dns.mkSOA "ns2.kitenet.net" 100) $
- [ (RootDomain, NS $ AbsDomain "ns2.kitenet.net")
- , (RootDomain, NS $ AbsDomain "ns3.kitenet.net")
- , (RootDomain, NS $ AbsDomain "ns6.gandi.net")
- , (RootDomain, MX 0 $ AbsDomain "kitenet.net")
- , (RootDomain, TXT "v=spf1 a ?all")
- ] ++ extras
-
-
- -- o
- -- ___ o o
- {-----\ / o \ ___o o
- { \ __ \ / _ (X___>-- __o
- _____________________{ ______\___ \__/ | \__/ \____ |X__>
- < \___//|\\___/\ \____________ _
- \ ___/ | \___ # # \ (-)
- \ O O O # | \ # >=)
- \______________________________# # / #__________________/ (-}
-
-
-monsters :: [Host] -- Systems I don't manage with propellor,
-monsters = -- but do want to track their public keys etc.
- [ host "usw-s002.rsync.net"
- & sshPubKey "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ=="
- , host "github.com"
- & sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="
- , host "ns6.gandi.net"
- & ipv4 "217.70.177.40"
- , host "turtle.kitenet.net"
- & ipv4 "67.223.19.96"
- & ipv6 "2001:4978:f:2d9::2"
- & alias "backup.kitenet.net"
- & alias "usbackup.kitenet.net"
- & sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw=="
- , host "old.kitenet.net"
- & ipv4 "80.68.85.49"
- , host "mouse.kitenet.net"
- & ipv6 "2001:4830:1600:492::2"
- , host "beaver.kitenet.net"
- & ipv6 "2001:4830:1600:195::2"
- , host "hydra.kitenet.net"
- & ipv4 "192.25.206.60"
- , host "branchable.com"
- & ipv4 "66.228.46.55"
- & ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
- & alias "olduse.net"
- & alias "www.olduse.net"
- & alias "www.kitenet.net"
- & alias "joeyh.name"
- & alias "campaign.joeyh.name"
- & alias "ikiwiki.info"
- & alias "git.ikiwiki.info"
- & alias "l10n.ikiwiki.info"
- & alias "dist-bugs.kitenet.net"
- & alias "family.kitenet.net"
- , host "animx"
- & ipv4 "76.7.162.101"
- & ipv4 "76.7.162.186"
- ]
diff --git a/config-simple.hs b/config-simple.hs
index dcdc51a3..42b3d838 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -2,48 +2,28 @@
-- the propellor program.
import Propellor
-import Propellor.CmdLine
-import Propellor.Property.Scheduled
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
-import qualified Propellor.Property.Network as Network
---import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Cron as Cron
---import qualified Propellor.Property.Sudo as Sudo
import qualified Propellor.Property.User as User
---import qualified Propellor.Property.Hostname as Hostname
---import qualified Propellor.Property.Reboot as Reboot
---import qualified Propellor.Property.Tor as Tor
-import qualified Propellor.Property.Docker as Docker
main :: IO ()
main = defaultMain hosts
-- The hosts propellor knows about.
--- Edit this to configure propellor!
hosts :: [Host]
hosts =
- [ host "mybox.example.com"
- & os (System (Debian Unstable) "amd64")
- & Apt.stdSourcesList
- & Apt.unattendedUpgrades
- & Apt.installed ["etckeeper"]
- & Apt.installed ["ssh"]
- & User.hasSomePassword "root" (Context "mybox.example.com")
- & Network.ipv6to4
- & File.dirExists "/var/www"
- & Docker.docked hosts "webserver"
- & Docker.garbageCollected `period` Daily
- & Cron.runPropellor "30 * * * *"
-
- -- A generic webserver in a Docker container.
- , Docker.container "webserver" "joeyh/debian-stable"
- & os (System (Debian (Stable "wheezy")) "amd64")
- & Apt.stdSourcesList
- & Docker.publish "80:80"
- & Docker.volume "/var/www:/var/www"
- & Apt.serviceInstalledRunning "apache2"
-
- -- add more hosts here...
- --, host "foo.example.com" = ...
+ [ mybox
]
+
+-- An example host.
+mybox :: Host
+mybox = host "mybox.example.com" $ props
+ & osDebian Unstable "amd64"
+ & Apt.stdSourcesList
+ & Apt.unattendedUpgrades
+ & Apt.installed ["etckeeper"]
+ & Apt.installed ["ssh"]
+ & User.hasSomePassword (User "root")
+ & File.dirExists "/var/www"
+ & Cron.runPropellor (Cron.Times "30 * * * *")
diff --git a/contrib/post-merge-hook b/contrib/post-merge-hook
new file mode 100755
index 00000000..fa9ab5b6
--- /dev/null
+++ b/contrib/post-merge-hook
@@ -0,0 +1,44 @@
+#!/bin/sh
+#
+# git post-merge hook, used by propellor's author to maintain a
+# joeyconfig branch with some changes while being able to merge
+# between it and branches without the changes.
+#
+# Each time this hook is run, it checks if it's on a branch with
+# name ending in "config". If so, config.hs is pointed at $branch.hs
+# and privdata/relocate is written to make files in privdata/.$branch/ be
+# used.
+#
+# Otherwise, config.hs is pointed at config-simple.hs, and
+# privdata/relocate is removed.
+
+set -e
+
+commit () {
+ if [ -n "$(git status --short privdata/relocate config.hs)" ]; then
+ git commit privdata/relocate config.hs -m "$1"
+ fi
+}
+
+branch="$(git symbolic-ref --short HEAD)"
+case "$branch" in
+ "")
+ true
+ ;;
+ *config)
+ ln -sf "$branch".hs config.hs
+ git add config.hs
+ echo ".$branch" > privdata/relocate
+ git add privdata/relocate
+ commit "setting up $branch after merge"
+ ;;
+ *)
+ ln -sf config-simple.hs config.hs
+ git add config.hs
+ if [ -e privdata/relocate ]; then
+ rm -f privdata/relocate
+ git rm --quiet privdata/relocate
+ fi
+ commit "clean up after merge"
+ ;;
+esac
diff --git a/debian/changelog b/debian/changelog
index 8ef65e0f..804f4c89 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,890 @@
+propellor (3.0.5-1) unstable; urgency=medium
+
+ * Package new upstream release.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Fri, 10 Jun 2016 15:21:47 +0900
+
+propellor (3.0.5) unstable; urgency=medium
+
+ * Modules added for Sbuild and Ccache.
+ Thanks, Sean Whitton
+ * Systemd: Added killUserProcesses property, which can be reverted
+ to return systemd to its default behavior before version 230 started
+ killing processes like screen sessions.
+ * Systemd: Added logindConfigured property.
+
+ -- Joey Hess <id@joeyh.name> Mon, 06 Jun 2016 17:13:21 -0400
+
+propellor (3.0.4-1) unstable; urgency=medium
+
+ * Package new upstream release.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Tue, 24 May 2016 15:34:24 +0900
+
+propellor (3.0.4) unstable; urgency=medium
+
+ * Run letsencrypt with --noninteractive.
+ * Fix build with ghc 8.0.1.
+ Thanks, davean.
+ * Module added for the Borg backup system.
+ Thanks, Félix Sipma.
+ * Fix build with directory-1.2.6.2.
+
+ -- Joey Hess <id@joeyh.name> Sun, 22 May 2016 15:54:49 -0400
+
+propellor (3.0.3-2) unstable; urgency=medium
+
+ * Use CDBS & haskell-devscripts to build new binary packages
+ libghc-propellor-{dev,prof,doc}.
+ * Add X-Description: field to debian/control.
+ * Add patch removing README.Debian from propellor.cabal.
+ * Re-arrange files in debian/ to deal with multiple binary packages.
+ - Use debian/propellor.manpages and debian/propellor.docs instead of
+ overrides in debian/rules.
+ - Add Lintian overrides duplicate-{short,long}-description.
+ - Rename README.Debian, lintian-overrides to correspond to particular
+ binary packages.
+ - Add libghc-propellor-{dev,prof,doc}.links duplicating propellor.links.
+ * Binary package propellor now depends on libghc-propellor-dev.
+ This fixes using propellor as a library, as set up by propellor --init
+ option B. Closes:
+ https://propellor.branchable.com/todo/propellor_--init_option_B_failure/
+ * Update Source: field and copyright year in debian/copyright.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sat, 07 May 2016 10:59:53 -0700
+
+propellor (3.0.3-1) unstable; urgency=medium
+
+ * Package new upstream release.
+ * Bump standards version to 3.9.8 (no changes required).
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sun, 01 May 2016 17:12:29 -0700
+
+propellor (3.0.3) unstable; urgency=medium
+
+ * Remove Propellor.DotDir from the propellor library, as its use of
+ Paths_propellor prevents use of the module out of propellor's tree.
+ This module is only needed for the wrapper program anyway, which
+ handles --init.
+
+ -- Joey Hess <id@joeyh.name> Sun, 01 May 2016 17:51:37 -0400
+
+propellor (3.0.2) unstable; urgency=medium
+
+ * Added Apt.periodicUpdates.
+ Thanks, Félix Sipma.
+ * Apt.unattendedUpgrades: Enable mailing problem reports to root.
+ Thanks, Félix Sipma.
+ * Added Propellor.Property.Fstab, and moved the fstabbed property to there.
+ * Attic module added for the backup system.
+ Thanks, Félix Sipma.
+ * Fix build with directory-1.2.6.2.
+
+ -- Joey Hess <id@joeyh.name> Sat, 30 Apr 2016 15:46:50 -0400
+
+propellor (3.0.1-1) unstable; urgency=medium
+
+ * Package new upstream release.
+ * Remove obsolete debian/NEWS to minimise confusion.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Wed, 06 Apr 2016 07:20:20 -0700
+
+propellor (3.0.1) unstable; urgency=medium
+
+ * propellor --init now runs cabal sandbox init if cabal has been
+ configured with require-sandbox: True.
+ Thanks, Sean Whitton
+ * Re-bundled concurrent-output so propellor can be deployed to Debian
+ stable systems without installing it (insecurely) from hackage.
+
+ -- Joey Hess <id@joeyh.name> Tue, 05 Apr 2016 13:35:54 -0400
+
+propellor (3.0.0-1) unstable; urgency=medium
+
+ * New upstream version.
+ * Create debian/NEWS to detail a caveat when upgrading to this new version.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sun, 03 Apr 2016 11:35:35 -0700
+
+propellor (3.0.0) unstable; urgency=medium
+
+ * Property types have been improved to indicate what systems they target.
+ This prevents using eg, Property FreeBSD on a Debian system.
+ Transition guide for this sweeping API change:
+ - First, upgrade to propellor 2.17.2 and deploy that to all your hosts.
+ Otherwise, propellor --spin will fail when you upgrade to
+ propellor 3.0.0.
+ - Change "host name & foo & bar"
+ to "host name $ props & foo & bar"
+ - Similarly, `propertyList` and `combineProperties` need `props`
+ to be used to combine together properties; they no longer accept
+ lists of properties. (If you have such a list, use `toProps`.)
+ - And similarly, Chroot, Docker, and Systemd container need `props`
+ to be used to combine together the properies used inside them.
+ - The `os` property is removed. Instead use `osDebian`, `osBuntish`,
+ or `osFreeBSD`. These tell the type checker the target OS of a host.
+ - Change "Property NoInfo" to "Property UnixLike"
+ - Change "Property HasInfo" to "Property (HasInfo + UnixLike)"
+ - Change "RevertableProperty NoInfo" to
+ "RevertableProperty UnixLike UnixLike"
+ - Change "RevertableProperty HasInfo" to
+ "RevertableProperty (HasInfo + UnixLike) UnixLike"
+ - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types.
+ This is enabled by default for all modules in propellor.cabal. But
+ if you are using propellor as a library, you may need to enable it
+ manually.
+ - If you know a property only works on a particular OS, like Debian
+ or FreeBSD, use that instead of "UnixLike". For example:
+ "Property Debian"
+ - It's also possible make a property support a set of OS's, for example:
+ "Property (Debian + FreeBSD)"
+ - Removed `infoProperty` and `simpleProperty` constructors, instead use
+ `property` to construct a Property.
+ - Due to the polymorphic type returned by `property`, additional type
+ signatures tend to be needed when using it. For example, this will
+ fail to type check, because the type checker cannot guess what type
+ you intend the intermediate property "go" to have:
+ foo :: Property UnixLike
+ foo = go `requires` bar
+ where
+ go = property "foo" (return NoChange)
+ To fix, specify the type of go:
+ go :: Property UnixLike
+ - `ensureProperty` now needs to be passed a witness to the type of the
+ property it's used in.
+ change this: foo = property desc $ ... ensureProperty bar
+ to this: foo = property' desc $ \w -> ... ensureProperty w bar
+ - General purpose properties like cmdProperty have type "Property UnixLike".
+ When using that to run a command only available on Debian, you can
+ tighten the type to only the OS that your more specific property works on.
+ For example:
+ upgraded :: Property Debian
+ upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
+ - Several utility functions have been renamed:
+ getInfo to fromInfo
+ propertyInfo to getInfo
+ propertyDesc to getDesc
+ propertyChildren to getChildren
+ * The new `pickOS` property combinator can be used to combine different
+ properties, supporting different OS's, into one Property that chooses
+ which to use based on the Host's OS.
+ * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling
+ these complex new types.
+ * Added dependency on concurrent-output; removed embedded copy.
+ * Apt.PPA: New module, contributed by Evan Cofsky.
+ * Improved propellor's first run experience; propellor --init will
+ walk the user through setting up ~/.propellor, with a choice between
+ a clone of propellor's git repository, or a minimal config, and will
+ configure propellor to use a gpg key.
+ * Stack support. "git config propellor.buildsystem stack" will make
+ propellor build its config using stack.
+ * When propellor is installed using stack, propellor --init will
+ automatically set propellor.buildsystem=stack.
+
+ -- Joey Hess <id@joeyh.name> Sat, 02 Apr 2016 15:33:26 -0400
+
+propellor (2.17.2-1) unstable; urgency=low
+
+ * New upstream version.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Thu, 31 Mar 2016 17:26:19 -0700
+
+propellor (2.17.2) unstable; urgency=medium
+
+ * When new dependencies are added to propellor or the propellor config,
+ try harder to get them installed. In particular, this makes
+ propellor --spin work when the remote host needs to get dependencies
+ installed in order to build the updated config.
+ * Apt.update: Also run dpkg --configure -a here as apt for some reason
+ won't even update if dpkg was interrupted.
+
+ -- Joey Hess <id@joeyh.name> Wed, 30 Mar 2016 15:45:08 -0400
+
+propellor (2.17.1-1) unstable; urgency=medium
+
+ * New upstream version.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Tue, 29 Mar 2016 08:30:00 -0700
+
+propellor (2.17.1) unstable; urgency=medium
+
+ * Avoid generating excessively long paths to the unix socket file
+ used for ssh connection caching. Mostly. Can still generate a too long
+ one if $HOME is longer than 60 bytes.
+ * Uwsgi: add ".ini" extension to app config files.
+ Files without extensions were ignored by uwsgi.
+ Thanks, Félix Sipma.
+
+ -- Joey Hess <id@joeyh.name> Mon, 28 Mar 2016 11:06:34 -0400
+
+propellor (2.17.0) unstable; urgency=medium
+
+ * Added initial support for FreeBSD.
+ Thanks, Evan Cofsky.
+ * Added Propellor.Property.ZFS.
+ Thanks, Evan Cofsky.
+ * Firewall: Reorganized Chain data type. (API change)
+ Thanks, Félix Sipma.
+ * Firewall: Separated Table and Target (API change)
+ Thanks, Félix Sipma.
+ * Ssh: change type of listenPort from Int to Port (API change)
+ Thanks, Félix Sipma.
+ * Firewall: add TCPFlag, Frequency, TCPSyn, ICMPTypeMatch, NatDestination
+ Thanks, Félix Sipma.
+ * Network: Filter out characters not allowed in interfaces.d files.
+ Thanks, Félix Sipma.
+ * Apt.upgrade: Run dpkg --configure -a first, to recover from
+ interrupted upgrades.
+ * Apt: Add safeupgrade.
+ * Force ssh, scp, and git commands to be run in the foreground.
+ Should fix intermittent hangs of propellor --spin.
+ * Avoid repeated re-building on systems such as FreeBSD where building
+ re-links the binary even when there are no changes.
+ * Locale.available: Run locale-gen, instead of dpkg-reconfigure locales,
+ which modified the locale.gen file and sometimes caused the property to
+ need to make changes every time.
+ * Speed up propellor's build of itself, by asking cabal to only build
+ the propellor-config binary and not all the libraries.
+ * Tor.named: Fix bug that sometimes caused the property to fail the first
+ time, though retrying succeeded.
+
+ -- Joey Hess <id@joeyh.name> Thu, 24 Mar 2016 14:53:31 -0400
+
+propellor (2.16.0-1) unstable; urgency=medium
+
+ * New upstream version.
+ * Create changelog symlink with dh_link instead of in debian/rules.
+ In accordance with policy 12.3: a package cannot assume the existence of
+ /usr/share/doc.
+ * Bump standards version to 3.9.7 (no changes required).
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sun, 28 Feb 2016 17:02:24 -0700
+
+propellor (2.16.0) unstable; urgency=medium
+
+ * Obnam: Only let one backup job run at a time when a host has multiple
+ different backup properties, to avoid concurrent jobs fighting over
+ scarce resources (particularly memory). Other jobs block on a lock
+ file.
+ * Removed references to a Debian derivative from code and documentation
+ because of an unfortunate trademark use policy.
+ http://joeyh.name/blog/entry/trademark_nonsense/
+ * That included changing a data constructor to "Buntish", an API change.
+ * Firewall.rule: Now takes a Table parameter. (API change)
+ * Firewall: add InIFace/OutIFace Rules, add Source/Destination Rules,
+ add CustomTarget, and more improvements.
+ Thanks, Félix Sipma.
+ * Ssh.authorizedKey: Fix bug preventing it from working when the
+ authorized_keys file does not yet exist.
+ * Removed Ssh.unauthorizedKey and made Ssh.authorizedKey revertable.
+ (API change)
+
+ -- Joey Hess <id@joeyh.name> Sat, 27 Feb 2016 13:31:57 -0400
+
+propellor (2.15.4-1) unstable; urgency=medium
+
+ * New upstream version.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sat, 13 Feb 2016 11:52:53 -0700
+
+propellor (2.15.4) unstable; urgency=medium
+
+ * Build /usr/src/propellor/propellor.git reproducibly,
+ which makes the whole Debian package build reproducibly.
+ Thanks, Sean Whitton.
+ * Obnam: To cause old generations to be forgotten, keepParam can be
+ passed to a backup property; this causes obnam forget to be run.
+ * Delete /etc/apt/apt.conf.d/50unattended-upgrades.ucf-dist when
+ unattended-upgrades is installed, to work around #812380 which results
+ in many warnings from apt, including in cron mails.
+ * Added Propellor.Property.LetsEncrypt
+ * Apache.httpsVirtualHost: New property, setting up a https vhost
+ with the certificate automatically obtained using letsencrypt.
+ * Allow using combineProperties and propertyList with lists of
+ RevertableProperty.
+
+ -- Joey Hess <id@joeyh.name> Thu, 11 Feb 2016 12:49:10 -0400
+
+propellor (2.15.3-1) unstable; urgency=medium
+
+ * New upstream version.
+ * Fix override of Lintian tag debian-watch-may-check-gpg-signature.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Tue, 12 Jan 2016 19:41:07 -0700
+
+propellor (2.15.3) unstable; urgency=medium
+
+ * Added Git.bareRepoDefaultBranch property
+ Thanks, Sean Whitton.
+ * Add missing Control.Applicative imports needed by older versions of ghc.
+
+ -- Joey Hess <id@joeyh.name> Tue, 12 Jan 2016 12:37:22 -0400
+
+propellor (2.15.2-1) unstable; urgency=medium
+
+ * New upstream version.
+ * Fix duplicate Section: in debian/control file.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Mon, 04 Jan 2016 12:14:47 +0000
+
+propellor (2.15.2) unstable; urgency=medium
+
+ * Added GNUPGBIN environment variable or git.program git config
+ to control the command run for gpg. Allows eg, GNUPGBIN=gpg2
+ Thanks, Félix Sipma.
+ * Bootstrap apt-get installs run with deconf noninteractive frontend.
+ * spin --via: Avoid committing on relay host.
+ * Postfix: Add service property to enable/disable services in master.cf.
+ * Added Munin module, contributed by Jelmer Vernooij.
+
+ -- Joey Hess <id@joeyh.name> Sun, 03 Jan 2016 16:56:26 -0400
+
+propellor (2.15.1-1) unstable; urgency=medium
+
+ * New upstream version.
+ * Add watch file.
+ * Fix specification of packaging branch in Vcs-Git: variable.
+ * Silence xargs during package build when hothasktags is not installed.
+ Patch accepted upstream for next upstream release.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sun, 03 Jan 2016 17:05:27 +0000
+
+propellor (2.15.1) unstable; urgency=medium
+
+ * Added git configs propellor.spin-branch and propellor.forbid-dirty-spin.
+ Thanks, Sean Whitton.
+ * Added User.systemAccountFor and User.systemAccountFor' properties.
+ Thanks, Félix Sipma.
+ * Gpg.keyImported converted to not use a flag file and instead check
+ if gpg has the provided key already.
+ Thanks, Félix Sipma.
+ * Clean build with ghc 7.10.
+ * Merged Utility changes from git-annex.
+
+ -- Joey Hess <id@joeyh.name> Sat, 19 Dec 2015 16:43:09 -0400
+
+propellor (2.15.0-1) unstable; urgency=medium
+
+ * Adopt propellor package (Closes: #768634).
+ * Switch dpkg-source format to 3.0 (quilt).
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sun, 13 Dec 2015 11:33:02 -0700
+
+propellor (2.15.0) unstable; urgency=medium
+
+ * Added UncheckedProperty type, along with unchecked to indicate a
+ Property needs its result checked, and checkResult and changesFile
+ to check for changes.
+ * Properties that run an arbitrary command, such as cmdProperty
+ and scriptProperty are converted to use UncheckedProperty, since
+ they cannot tell on their own if the command truely made a change or not.
+ (API Change)
+ Transition guide:
+ - When GHC complains about an UncheckedProperty, add:
+ `assume` MadeChange
+ (Since these properties used to always return MadeChange, that
+ change is always safe to make.)
+ - Or, if you know that the command should modifiy a file, use:
+ `changesFile` filename
+ * The `trivial` combinator has been removed. (API change)
+ Instead, use:
+ `assume` NoChange
+ Or, better, use changesFile or checkResult to accurately report
+ when a property makes a change.
+ * A few properties have had their Result improved, for example
+ Apt.buldDep and Apt.autoRemove now check if a change was made or not.
+ * User.hasDesktopGroups changed to avoid trying to add the user to
+ groups that don't exist.
+ * Added Postfix.saslPasswdSet.
+ * Added Propellor.Property.Locale.
+ Thanks, Sean Whitton.
+ * Added Propellor.Property.Fail2Ban.
+
+ -- Joey Hess <id@joeyh.name> Sun, 06 Dec 2015 15:33:51 -0400
+
+propellor (2.14.0) unstable; urgency=medium
+
+ * Add Propellor.Property.PropellorRepo.hasOriginUrl, an explicit way to
+ set the git repository url normally implicitly set when using --spin.
+ * Added Chroot.noServices property.
+ * DiskImage creation automatically uses Chroot.noServices.
+ * Removed the (unused) dependency on quickcheck.
+ * DebianMirror: Added a DebianMirror type for configuration (API change)
+ Thanks, Félix Sipma.
+ * DebianMirror: Add RsyncExtra to configuration.
+ Thanks, Félix Sipma.
+ * Added Git.repoConfigured and Git.repoAcceptsNonFFs properties.
+ Thanks, Sean Whitton
+ * Added User.hasDesktopGroups property.
+
+ -- Joey Hess <id@joeyh.name> Tue, 24 Nov 2015 16:03:55 -0400
+
+propellor (2.13.0) unstable; urgency=medium
+
+ * RevertableProperty used to be assumed to contain info, but this is
+ now made explicit, with RevertableProperty HasInfo or
+ RevertableProperty NoInfo. (API change)
+ Transition guide:
+ - If you define a RevertableProperty, expect some type check
+ failures like: "Expecting one more argument to ‘RevertableProperty’".
+ - Change it to "RevertableProperty NoInfo"
+ - The compiler will then tell you if it needs "HasInfo" instead.
+ - If you have code that uses the RevertableProperty constructor
+ that fails to type check, use the more powerful <!> operator
+ instead to create the RevertableProperty.
+ * Various property combinators that combined a RevertableProperty
+ with a non-revertable property used to yield a RevertableProperty.
+ This was a bug, because the combined property could not be fully
+ reverted in many cases, and the result is now a non-revertable property.
+ * combineWith now takes an additional parameter to control how revert
+ actions are combined (API change).
+ * Added Propellor.Property.Concurrent for concurrent properties.
+ * Made the execProcess exported by propellor, and everything built on it,
+ avoid scrambled output when run concurrently.
+ * Propellor now depends on STM and text.
+ * The cabal file now builds propellor with -O. While -O0 makes ghc
+ take less memory while building propellor, it can lead to bad memory
+ usage at runtime due to eg, disabled stream fusion.
+ * Add File.isCopyOf. Thanks, Per Olofsson.
+
+ -- Joey Hess <id@joeyh.name> Sun, 08 Nov 2015 14:51:15 -0400
+
+propellor (2.12.0) unstable; urgency=medium
+
+ * The DiskImage module can now make bootable images using grub.
+ * Add a ChrootTarball chroot type, for using pre-built tarballs
+ as chroots. Thanks, Ben Boeckel.
+ * HostName: Improve domain extraction code.
+ * Added Mount.fstabbed property to generate /etc/fstab to replicate
+ current mounts.
+ * HostName: Improve domain extraction code.
+ * Add File.basedOn. Thanks, Per Olofsson.
+ * Changed how the operating system is provided to Chroot (API change).
+ Where before debootstrapped and bootstrapped took a System parameter,
+ the os property should now be added to the Chroot.
+ * Follow-on change to Systemd.container, which now takes a System parameter.
+ * Generalized Property.check so it can be used with Propellor actions as
+ well as IO actions.
+ * Hostname.sane and Hostname.setTo can now safely be used as a property
+ of a chroot, and won't affect the hostname of the host system.
+
+ -- Joey Hess <id@joeyh.name> Fri, 23 Oct 2015 17:38:32 -0400
+
+propellor (2.11.0) unstable; urgency=medium
+
+ * Rewrote Propellor.Property.ControlHeir one more time, renaming it to
+ Propellor.Property.Conductor.
+ * Added Ssh properties to remove authorized_keys and known_hosts lines.
+
+ -- Joey Hess <id@joeyh.name> Wed, 21 Oct 2015 19:49:00 -0400
+
+propellor (2.10.0) unstable; urgency=medium
+
+ * The Propellor.Property.Spin added in the last release is replaced
+ with a very different Propellor.Property.ControlHeir.
+
+ -- Joey Hess <id@joeyh.name> Tue, 20 Oct 2015 21:29:12 -0400
+
+propellor (2.9.0) unstable; urgency=medium
+
+ * Added basic Uwsgi module, maintained by Félix Sipma.
+ * Add Apt.hasForeignArch. Thanks, Per Olofsson.
+ * Improved documentation, particularly of the Propellor module.
+ * The Propellor module no longer exports many of the things it used to,
+ being now focused on only what's needed to write config.hs.
+ Use Propellor.Base to get all the things exported by Propellor before.
+ (API change)
+ * Some renaming of instance methods, and moving of functions to more
+ appropriate modules. (API change)
+ * Added File.isSymlinkedTo. Thanks, Per Olofsson.
+ * fileProperty, and properties derived from it now write the new
+ file content via origfile.propellor-new~, instead of to a randomly named
+ temp file. This allows them to clean up any temp file that may have
+ been left by an interrupted run of propellor.
+ * Added Propellor.Property.Spin, which can be used to make a host be a
+ controller of other hosts, which will automatically spin them each time
+ propellor is run.
+ * Ssh.keyImported is replaced with Ssh.userKeys. (API change)
+ The new property only gets the private key from the privdata; the
+ public key is provided as a parameter, and so is available as
+ Info that other properties can use.
+ * Ssh.keyImported' is renamed to Ssh.userKeyAt, and also changed
+ to only import the private key from the privdata. (API change)
+ * While Ssh.keyImported and Ssh.keyImported' avoided updating existing
+ keys, the new Ssh.userKeys and Ssh.userKeyAt properties will
+ always update out of date key files.
+ * Ssh.pubKey renamed to Ssh.hostPubKey. (API change)
+ * Added --unset-unused
+ * Fix typo: propigate → propagate. Thanks, Felix Gruber.
+ (A minor API change)
+ * Chroot: Converted to use a ChrootBootstrapper type class, so
+ other ways to bootstrap chroots can easily be added in separate
+ modules. (API change)
+
+ -- Joey Hess <id@joeyh.name> Tue, 20 Oct 2015 15:43:12 -0400
+
+propellor (2.8.1) unstable; urgency=medium
+
+ * Guard against power loss etc when building propellor, by updating
+ the executable atomically.
+ * Added Logcheck module, contributed by Jelmer Vernooij.
+ * Added Kerberos module, contributed by Jelmer Vernooij.
+ * Privdata that uses HostContext inside a container will now have the
+ name of the container as its context, rather than the name of
+ the host(s) where the container is used. This allows eg, having different
+ passwords for a user in different containers. Note that previously,
+ propellor would prompt using the container name as the context, but
+ not actually use privdata using that context; so this is a bug fix.
+ * Fix --add-key to not fail committing when no privdata file exists yet.
+
+ -- Joey Hess <id@joeyh.name> Sun, 04 Oct 2015 13:54:59 -0400
+
+propellor (2.8.0) unstable; urgency=medium
+
+ * Added Propellor.Property.Rsync.
+ * Convert Info to use Data.Dynamic, so properties can export and consume
+ info of any type that is Typeable and a Monoid, including data types
+ private to a module. (API change)
+ Thanks to Joachim Breitner for the idea.
+ * Improve propellor wrapper to better handle installation cloning
+ the public propellor repo, by setting that repo to be upstream,
+ so propellor doesnt try to push to a read-only repo.
+ * Added DebianMirror module, contributed by Félix Sipma.
+ * Some hlint cleanups.
+ Thanks, Mario Lang
+ * Added Propellor.Property.Unbound for the caching DNS server.
+ Thanks, Félix Sipma.
+ * Added PTR to Dns.Record. While this is ignored by
+ Propellor.Property.Dns for now, since reverse DNS setup is not
+ implemented there yet, it can be used in other places, eg Unbound.
+ Thanks, Félix Sipma.
+ * PrivData converted to newtype (API change).
+ * Stopped stripping trailing newlines when setting PrivData;
+ this was previously done to avoid mistakes when pasting eg passwords
+ with an unwanted newline. Instead, PrivData consumers should use either
+ privDataLines or privDataVal, to extract respectively lines or a
+ value (without internal newlines) from PrivData.
+ * Allow storing arbitrary ByteStrings in PrivData, extracted using
+ privDataByteString.
+ * Added Aiccu module, contributed by Jelmer Vernooij.
+ * Added --rm-key.
+
+ -- Joey Hess <id@joeyh.name> Tue, 22 Sep 2015 19:35:07 -0400
+
+propellor (2.7.3) unstable; urgency=medium
+
+ * Fix bug that caused provisioning new chroots to fail.
+ * Update for Debian systemd-container package split.
+ * Added Propellor.Property.Parted, for disk partitioning.
+ * Added Propellor.Property.Partition, for partition formatting etc.
+ * Added Propellor.Property.DiskImage, for bootable disk image creation.
+ (Experimental and not yet complete.)
+ * Dropped support for ghc 7.4.
+
+ -- Joey Hess <id@joeyh.name> Thu, 03 Sep 2015 08:52:51 -0700
+
+propellor (2.7.2) unstable; urgency=medium
+
+ * Added Propellor.Property.ConfFile, with support for Windows-style .ini
+ files, and generic support for files containing some sort of sections.
+ Thanks, Sean Whitton for completing the implementation.
+ * Added Propellor.Property.LightDM
+ Thanks, Sean Whitton.
+ * Multiple Tor.hiddenService properties can now be defined for a host;
+ previously only one such property worked per host.
+ Thanks, Félix Sipma.
+
+ -- Joey Hess <id@joeyh.name> Tue, 25 Aug 2015 12:00:25 -0700
+
+propellor (2.7.1) unstable; urgency=medium
+
+ * Make sure that make is installed when bootstrapping propellor.
+ * Fix bug in Firewall's Port datatype to iptable parameter translation code.
+ Thanks, Antoine Eiche.
+
+ -- Joey Hess <id@joeyh.name> Fri, 14 Aug 2015 15:01:37 -0400
+
+propellor (2.7.0) unstable; urgency=medium
+
+ * Ssh.permitRootLogin type changed to allow configuring WithoutPassword
+ and ForcedCommandsOnly (API change)
+ * setSshdConfig type changed, and setSshdConfigBool added with old type.
+ * Fix a bug in shim generation code for docker and chroots, that
+ sometimes prevented deployment of docker containers.
+ * Added onChangeFlagOnFail which is often a safer alternative to
+ onChange.
+ Thanks, Antoine Eiche.
+ * Work around broken git pull option parser in git 2.5.0,
+ which broke use of --upload-pack to send a git push when running
+ propellor --spin.
+
+ -- Joey Hess <id@joeyh.name> Thu, 30 Jul 2015 12:05:46 -0400
+
+propellor (2.6.0) unstable; urgency=medium
+
+ * Replace String type synonym Docker.Image by a data type
+ which allows to specify an image name and an optional tag. (API change)
+ Thanks, Antoine Eiche.
+ * Added --unset to delete a privdata field.
+ * Version dependency on exceptions.
+ * Systemd: Add masked property.
+ Thanks, Sean Whitton
+ * Fix make install target to work even when git is not configured.
+
+ -- Joey Hess <id@joeyh.name> Fri, 10 Jul 2015 22:36:29 -0400
+
+propellor (2.5.0) unstable; urgency=medium
+
+ * cmdProperty' renamed to cmdPropertyEnv to make way for a new,
+ more generic cmdProperty' (API change)
+ * Add docker image related properties.
+ Thanks, Antoine Eiche.
+ * Export CommandParam, boolSystem, safeSystem, shellEscape, and
+ createProcess from Propellor.Property.Cmd, so they are available
+ for use in constricting your own Properties when using propellor
+ as a library.
+ * Improve enter-machine scripts for systemd-nspawn containers to unset most
+ environment variables.
+ * Fix Postfix.satellite bug; the default relayhost was set to the
+ domain, not to smtp.domain as documented.
+ * Mount /proc inside a chroot before provisioning it, to work around #787227
+ * --spin now works when given a short hostname that only resolves to an
+ ipv6 address.
+ * Added publish property for systemd-spawn containers, for port publishing.
+ (Needs systemd version 220.)
+ * Added bind and bindRo properties for systemd-spawn containers.
+ * Firewall: Port was changed to a newtype, and the Port and PortRange
+ constructors of Rules were changed to DPort and DportRange, respectively.
+ (API change)
+ * Docker: volume and publish accept Bound FilePath and Bound Port,
+ respectively. They also continue to accept Strings, for backwards
+ compatibility.
+ * Docker: Added environment property.
+ Thanks Antoine Eiche.
+
+ -- Joey Hess <id@joeyh.name> Tue, 09 Jun 2015 17:08:43 -0400
+
+propellor (2.4.0) unstable; urgency=medium
+
+ * Propellor no longer supports Debian wheezy (oldstable).
+ * Git.bareRepo: Fix bug in calls to userScriptProperty.
+ Thanks, Jelmer Vernooij.
+ * Removed Obnam.latestVersion which was only needed for Debian wheezy
+ backport.
+ * Merged Utility changes from git-annex.
+ * Switched from MonadCatchIO-transformers to the newer transformers and
+ exceptions libraries.
+ * Ensure build deps are installed before building propellor in --spin
+ and cron job, even if propellor was already built before, to deal with
+ upgrades that add new dependencies.
+
+ -- Joey Hess <id@joeyh.name> Wed, 06 May 2015 14:28:59 -0400
+
+propellor (2.3.0) unstable; urgency=medium
+
+ * Make propellor resistent to changes to shared libraries, such as libffi,
+ which might render the propellor binary unable to run. This is dealt with
+ by checking the binary both when running propellor on a remote host,
+ and by Cron.runPropellor. If the binary doesn't work, it will be rebuilt.
+ * Note that since a new switch had to be added to allow testing the binary,
+ upgrading to this version will cause a rebuild from scratch of propellor.
+ * Added hasLoginShell and shellEnabled.
+ * debCdn changed to new httpredir.debian.org official replacement for
+ http.debian.net.
+ * API change: Added User and Group newtypes, and Properties that
+ used to use the type UserName = String were changed to use them.
+
+ -- Joey Hess <id@joeyh.name> Wed, 22 Apr 2015 13:46:24 -0400
+
+propellor (2.2.1) unstable; urgency=medium
+
+ * userScriptProperty now passes --shell /bin/sh, so it can be used
+ even for users with nonstandard shells.
+ * Fix bug in docker propellor shim setup introduced in last release,
+ which broke provisioning of new docker containers.
+
+ -- Joey Hess <id@joeyh.name> Thu, 12 Mar 2015 20:08:34 -0400
+
+propellor (2.2.0) unstable; urgency=medium
+
+ * When running shimmed (eg in a docker container),
+ improve process name visible in ps.
+ * Add shebang to cron.daily etc files.
+ * Some changes to tor configuration, minor API change.
+ * Propellor now builds itself, and gets its build dependencies installed
+ when deploying to a new host, without needing the Makefile.
+
+ -- Joey Hess <id@joeyh.name> Mon, 09 Mar 2015 12:02:31 -0400
+
+propellor (2.1.0) unstable; urgency=medium
+
+ * Additional tor properties, including support for making relays,
+ and naming bridges, relays, etc.
+ * New Cron.Times data type, which allows Cron.job to install
+ daily/monthly/weekly jobs that anacron can run. (API change)
+ * Fix Git.daemonRunning to restart inetd after enabling the git server.
+ * Ssh.authorizedKey: Make the authorized_keys file and .ssh directory
+ be owned by the user, not root.
+ * Ssh.knownHost: Make the .ssh directory be owned by the user, not root.
+
+ -- Joey Hess <id@joeyh.name> Thu, 12 Feb 2015 12:36:26 -0400
+
+propellor (2.0.0) unstable; urgency=medium
+
+ * Property has been converted to a GADT, and will be Property NoInfo
+ or Property HasInfo.
+ This was done to make sure that ensureProperty is only used on
+ properties that do not have Info.
+ Transition guide:
+ - Change all "Property" to "Property NoInfo" or "Property HasInfo"
+ (The compiler can tell you if you got it wrong!)
+ - To construct a RevertableProperty, it is useful to use the new
+ (<!>) operator
+ - Constructing a list of properties can be problimatic, since
+ Property NoInto and Property HasInfo are different types and cannot
+ appear in the same list. To deal with this, "props" has been added,
+ and can built up a list of properties of different types,
+ using the same (&) and (!) operators that are used to build
+ up a host's properties.
+ * Add descriptions of how to set missing fields to --list-fields output.
+ * Properties now form a tree, instead of the flat list used before.
+ This includes the properties used inside a container.
+ * Fix info propagation from fallback combinator's second Property.
+ * Added systemd configuration properties.
+ * Added journald configuration properties.
+ * Added more network interface configuration properties.
+ * Implemented OS.preserveNetwork.
+
+ -- Joey Hess <id@joeyh.name> Sun, 25 Jan 2015 15:23:08 -0400
+
+propellor (1.3.2) unstable; urgency=medium
+
+ * SSHFP records are also generated for CNAMES of hosts.
+ * Merge Utiity modules from git-annex.
+ * Ignore bogus DNS when spinning the local host.
+
+ -- Joey Hess <id@joeyh.name> Thu, 15 Jan 2015 14:02:07 -0400
+
+propellor (1.3.1) unstable; urgency=medium
+
+ * Fix bug that prevented deploying ssh host keys when the file for the
+ key didn't already exist.
+ * DNS records for hosts with known ssh public keys now automatically
+ include SSHFP records.
+
+ -- Joey Hess <id@joeyh.name> Sun, 04 Jan 2015 19:51:34 -0400
+
+propellor (1.3.0) unstable; urgency=medium
+
+ * --spin checks if the DNS matches any configured IP address property
+ of the host, and if not, sshes to the host by IP address.
+ * Detect #774376 and refuse to use docker if the system is so broken
+ that docker exec doesn't enter a chroot.
+ * Update intermediary propellor in --spin --via
+ * Added support for DNSSEC.
+ * Ssh.hostKey and Ssh.hostKeys no longer install public keys from
+ the privdata. Instead, the public keys are included in the
+ configuration. (API change)
+ * Ssh.hostKeys now removes any host keys of types that the host is not
+ configured to have.
+ * sshPubKey is renamed to Ssh.pubKey, and has an added SshKeyType
+ parameter. (API change)
+ * CloudAtCost.deCruft no longer forces randomHostKeys.
+ * Fix build with process 1.2.1.0.
+
+ -- Joey Hess <id@joeyh.name> Sun, 04 Jan 2015 17:17:44 -0400
+
+propellor (1.2.2) unstable; urgency=medium
+
+ * Revert ensureProperty warning message, too many false positives in places
+ where Info is correctly propagated. Better approach needed.
+
+ -- Joey Hess <id@joeyh.name> Sun, 21 Dec 2014 21:41:11 -0400
+
+propellor (1.2.1) unstable; urgency=medium
+
+ * Added CryptPassword to PrivDataField, for password hashes as produced
+ by crypt(3).
+ * User.hasPassword and User.hasSomePassword will now use either
+ a CryptPassword or a Password from privdata, depending on which is set.
+
+ -- Joey Hess <id@joeyh.name> Wed, 17 Dec 2014 16:30:44 -0400
+
+propellor (1.2.0) unstable; urgency=medium
+
+ * Display a warning when ensureProperty is used on a property which has
+ Info and is so prevented from propigating it.
+ * Removed boolProperty; instead the new toResult can be used. (API change)
+ * Include Propellor.Property.OS, which was accidentially left out of the
+ cabal file in the last release.
+ * Fix Apache.siteEnabled to update the config file and reload apache when
+ configuration has changed.
+
+ -- Joey Hess <id@joeyh.name> Tue, 09 Dec 2014 00:05:09 -0400
+
+propellor (1.1.0) unstable; urgency=medium
+
+ * --spin target --via relay causes propellor to bounce through an
+ intermediate relay host, which handles any necessary uploads
+ when provisioning the target host.
+ * --spin can be passed multiple hosts, and it will provision each host
+ in turn.
+ * Add --merge, to combine multiple --spin commits into a single, more useful
+ commit.
+ * Hostname parameters not containing dots are looked up in the DNS to
+ find the full hostname.
+ * propellor --spin can now deploy propellor to hosts that do not have
+ git, ghc, or apt-get. This is accomplished by uploading a fairly
+ portable precompiled tarball of propellor.
+ * Propellor.Property.OS contains properties that can be used to do a clean
+ reinstall of the OS of an existing host. This can be used, for example,
+ to do an in-place conversion from Fedora to Debian.
+ This is experimental; use with caution!
+ * Added group-related properties. Thanks, Félix Sipma.
+ * Added Git.barerepo. Thanks, Félix Sipma.
+ * Added Grub.installed and Grub.boots properties.
+ * New HostContext can be specified when a PrivData value varies per host.
+ * hasSomePassword and hasPassword now default to using HostContext.
+ To specify a different context, use hasSomePassword' and
+ hasPassword' (API change)
+ * hasSomePassword and hasPassword now make sure shadow passwords are enabled.
+ * cron.runPropellor now runs propellor, rather than using its Makefile.
+ This is more robust.
+ * propellor.debug can be set in the git config to enable more persistent
+ debugging output.
+ * Run apt-cache policy with LANG=C so it works on other locales.
+ * endAction can be used to register an action to run once propellor
+ has successfully run on a host.
+
+ -- Joey Hess <id@joeyh.name> Sun, 07 Dec 2014 15:23:59 -0400
+
+propellor (1.0.0) unstable; urgency=medium
+
+ * propellor --spin can now be used to update remote hosts, without
+ any central git repository needed. The central git repository is
+ still useful for running propellor from cron, but this simplifies
+ getting started with propellor, and allows for more ad-hoc usage.
+ * The git repo url, if any, is updated whenever propellor --spin is used.
+ * Added prosody module, contributed by Félix Sipma.
+ * Can be used to configure tor hidden services. Thanks, Félix Sipma.
+ * When multiple gpg keys are added, ensure that the privdata file
+ can be decrypted by all of them.
+ * Convert GpgKeyId to newtype. (API change)
+ * DigitalOcean.distroKernel property now reboots into the distribution
+ kernel when necessary.
+ * Avoid outputting color setting sequences when not run on a terminal.
+ * Docker code simplified by using `docker exec`; needs docker 1.3.1.
+ * Docker containers are now a separate data type, cannot be included
+ in the main host list, and are instead passed to
+ Docker.docked. (API change)
+ * Added support for using debootstrap from propellor.
+ * Propellor can now be used to provision chroots.
+ * systemd-nspawn containers can now be managed by propellor, very similar
+ to its handling of docker containers.
+ * Debian package will be maintained by Gergely Nagy.
+
+ -- Joey Hess <id@joeyh.name> Fri, 21 Nov 2014 20:58:02 -0400
+
propellor (0.9.2) unstable; urgency=medium
* Added nginx module, contributed by Félix Sipma.
@@ -5,6 +892,7 @@ propellor (0.9.2) unstable; urgency=medium
* Apache: Fix daemon reload when enabling a new module or site.
* Docker: Stop using docker.io; that was a compat symlink in
the Debian package which has been removed in docker.io 1.3.1~dfsg1-2.
+ Closes: #769452
* Orphaned the Debian package, as I am retiring from Debian.
-- Joey Hess <joeyh@debian.org> Sat, 08 Nov 2014 15:57:36 -0400
@@ -13,7 +901,7 @@ propellor (0.9.1) unstable; urgency=medium
* Docker: Add ability to control when containers restart.
* Docker: Default to always restarting containers, so they come back
- up after reboots and docker daemon upgrades.
+ up after reboots and docker daemon upgrades. (API change)
* Fix loop when a docker host that does not exist was docked.
-- Joey Hess <joeyh@debian.org> Fri, 24 Oct 2014 09:57:31 -0400
@@ -26,7 +914,7 @@ propellor (0.9.0) unstable; urgency=medium
Instead, the os property for a stable system includes the suite name
to use, eg Stable "wheezy".
* stdSourcesList uses the stable suite name, to avoid unwanted
- immediate upgrades to the next stable release.
+ immediate upgrades to the next stable release. (API change)
* debCdn switched from cdn.debian.net to http.debian.net, which seems to be
better managed now.
* Docker: Avoid committing container every time it's started up.
@@ -101,7 +989,7 @@ propellor (0.7.0) unstable; urgency=medium
* combineProperties no longer stops when a property fails; now it continues
trying to satisfy all properties on the list before propigating the
failure.
- * Attr is renamed to Info.
+ * Attr is renamed to Info. (API change)
* Renamed wrapper to propellor to make cabal installation of propellor work.
* When git gpg signature of a fetched git branch cannot be verified,
propellor will now continue running, but without merging in that branch.
@@ -114,7 +1002,7 @@ propellor (0.6.0) unstable; urgency=medium
docked in. So if a docker container sets a DNS alias, every container
it's docked in will automatically be added to a DNS round-robin,
when propellor is used to manage DNS for the domain.
- * Apt.stdSourcesList no longer needs a suite to be specified.
+ * Apt.stdSourcesList no longer needs a suite to be specified. (API change)
* Added --dump to dump out a field of a host's privdata. Useful for editing
it.
* Propellor's output now includes the hostname being provisioned, or
@@ -157,7 +1045,7 @@ propellor (0.5.1) unstable; urgency=medium
propellor (0.5.0) unstable; urgency=medium
* Removed root domain records from SOA. Instead, use RootDomain
- when calling Dns.primary.
+ when calling Dns.primary. (API change)
* Dns primary and secondary properties are now revertable.
* When unattendedUpgrades is enabled on an Unstable or Testing system,
configure it to allow the upgrades.
@@ -171,8 +1059,9 @@ propellor (0.4.0) unstable; urgency=medium
zone files, which is done by looking at the properties of hosts
in a domain.
* The `cname` property was renamed to `alias` as it does not always
- generate CNAME in the DNS.
+ generate CNAME in the DNS. (API change)
* Constructor of Property has changed (use `property` function instead).
+ (API change)
* All Property combinators now combine together their Attr settings.
So Attr settings can be made inside a propertyList, for example.
* Run all cron jobs under chronic from moreutils to avoid unnecessary
@@ -208,7 +1097,7 @@ propellor (0.3.0) unstable; urgency=medium
* Include security updates in sources.list for stable and testing.
* Use ssh connection caching, especially when bootstrapping.
* Properties now run in a Propellor monad, which provides access to
- attributes of the host.
+ attributes of the host. (API change)
-- Joey Hess <joeyh@debian.org> Fri, 11 Apr 2014 01:19:05 -0400
diff --git a/debian/control b/debian/control
index 714dd640..b90d9d49 100644
--- a/debian/control
+++ b/debian/control
@@ -1,45 +1,134 @@
Source: propellor
Section: admin
Priority: optional
-Build-Depends:
- debhelper (>= 9),
- git,
- ghc (>= 7.4),
- cabal-install,
- libghc-async-dev,
- libghc-missingh-dev,
- libghc-hslogger-dev,
- libghc-unix-compat-dev,
- libghc-ansi-terminal-dev,
- libghc-ifelse-dev,
- libghc-network-dev,
- libghc-quickcheck2-dev,
- libghc-mtl-dev,
- libghc-monadcatchio-transformers-dev,
-Maintainer: Debian QA Group <packages@qa.debian.org>
-Standards-Version: 3.9.5
-Vcs-Git: git://git.kitenet.net/propellor
-Homepage: http://propellor.branchable.com/
+Build-Depends:
+ cabal-install,
+ cdbs,
+ debhelper (>= 9),
+ ghc (>= 7.6),
+ git,
+ haskell-devscripts,
+ libghc-ansi-terminal-dev,
+ libghc-ansi-terminal-prof,
+ libghc-async-dev,
+ libghc-async-prof,
+ libghc-concurrent-output-dev,
+ libghc-concurrent-output-prof,
+ libghc-exceptions-dev (>= 0.6),
+ libghc-exceptions-prof (>= 0.6),
+ libghc-hslogger-dev,
+ libghc-hslogger-prof,
+ libghc-ifelse-dev,
+ libghc-ifelse-prof,
+ libghc-missingh-dev,
+ libghc-missingh-prof,
+ libghc-mtl-dev,
+ libghc-mtl-prof,
+ libghc-network-dev,
+ libghc-network-prof,
+ libghc-stm-dev,
+ libghc-stm-prof,
+ libghc-text-dev,
+ libghc-text-prof,
+ libghc-transformers-dev,
+ libghc-transformers-prof,
+ libghc-unix-compat-dev,
+ libghc-unix-compat-prof,
+Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+Standards-Version: 3.9.8
+Homepage: https://propellor.branchable.com/
+Vcs-Git: https://git.spwhitton.name/propellor -b debian
+Vcs-Browser: https://git.spwhitton.name/?p=propellor.git;a=summary
+X-Description: property-based host configuration management in haskell
+ Propellor ensures that the system it's run in satisfies a list of
+ properties, taking action as necessary when a property is not yet met.
+ .
+ It is configured using haskell.
+ .
+ The easiest way to get started with propellor is to install the binary package
+ `propellor' and run `propellor --init'.
+
+Package: libghc-propellor-dev
+Section: haskell
+Architecture: any
+Depends:
+ ${haskell:Depends},
+ ${misc:Depends},
+ ${shlibs:Depends},
+Recommends:
+ ${haskell:Recommends},
+Suggests:
+ ${haskell:Suggests},
+Conflicts:
+ ${haskell:Conflicts},
+Provides:
+ ${haskell:Provides},
+Description: ${haskell:ShortDescription}${haskell:ShortBlurb}
+ ${haskell:LongDescription}
+ .
+ ${haskell:Blurb}
+
+Package: libghc-propellor-doc
+Architecture: all
+Section: doc
+Depends:
+ ${haskell:Depends},
+ ${misc:Depends},
+Recommends:
+ ${haskell:Recommends},
+Suggests:
+ ${haskell:Suggests},
+Conflicts:
+ ${haskell:Conflicts},
+Description: ${haskell:ShortDescription}${haskell:ShortBlurb}
+ ${haskell:LongDescription}
+ .
+ ${haskell:Blurb}
+
+Package: libghc-propellor-prof
+Section: haskell
+Architecture: any
+Depends:
+ ${haskell:Depends},
+ ${misc:Depends},
+Recommends:
+ ${haskell:Recommends},
+Suggests:
+ ${haskell:Suggests},
+Conflicts:
+ ${haskell:Conflicts},
+Provides:
+ ${haskell:Provides},
+Description: ${haskell:ShortDescription}${haskell:ShortBlurb}
+ ${haskell:LongDescription}
+ .
+ ${haskell:Blurb}
Package: propellor
Architecture: any
-Section: admin
-Depends: ${misc:Depends}, ${shlibs:Depends},
- ghc (>= 7.4),
- cabal-install,
- libghc-async-dev,
- libghc-missingh-dev,
- libghc-hslogger-dev,
- libghc-unix-compat-dev,
- libghc-ansi-terminal-dev,
- libghc-ifelse-dev,
- libghc-network-dev,
- libghc-quickcheck2-dev,
- libghc-mtl-dev,
- libghc-monadcatchio-transformers-dev,
- git,
+Depends:
+ cabal-install,
+ ghc (>= 7.4),
+ git,
+ libghc-ansi-terminal-dev,
+ libghc-async-dev,
+ libghc-concurrent-output-dev,
+ libghc-exceptions-dev (>= 0.6),
+ libghc-hslogger-dev,
+ libghc-ifelse-dev,
+ libghc-missingh-dev,
+ libghc-mtl-dev,
+ libghc-network-dev,
+ libghc-propellor-dev,
+ libghc-stm-dev,
+ libghc-text-dev,
+ libghc-transformers-dev,
+ libghc-unix-compat-dev,
+ make,
+ ${misc:Depends},
+ ${shlibs:Depends},
Description: property-based host configuration management in haskell
- Propellor enures that the system it's run in satisfies a list of
+ Propellor ensures that the system it's run in satisfies a list of
properties, taking action as necessary when a property is not yet met.
.
It is configured using haskell.
diff --git a/debian/copyright b/debian/copyright
index 3bdd0103..ed919d3c 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -1,8 +1,8 @@
Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Source: native package
+Source: https://propellor.branchable.com/
Files: *
-Copyright: © 2010-2014 Joey Hess <joey@kitenet.net>
+Copyright: © 2010-2016 Joey Hess <id@joeyh.name> and contributors
License: BSD-2-clause
License: BSD-2-clause
diff --git a/debian/gbp.conf b/debian/gbp.conf
new file mode 100644
index 00000000..aeb3b43a
--- /dev/null
+++ b/debian/gbp.conf
@@ -0,0 +1,10 @@
+[DEFAULT]
+upstream-branch = master
+debian-branch = debian
+upstream-tag = %(version)s
+debian-tag = debian/%(version)s
+
+#postbuild = lintian $GBP_CHANGES_FILE
+color = on
+compression = xz
+compression-level = 9
diff --git a/debian/libghc-propellor-dev.links b/debian/libghc-propellor-dev.links
new file mode 100644
index 00000000..d4d34298
--- /dev/null
+++ b/debian/libghc-propellor-dev.links
@@ -0,0 +1 @@
+/usr/share/doc/libghc-propellor-dev/changelog.Debian.gz /usr/share/doc/libghc-propellor-dev/changelog.gz
diff --git a/debian/libghc-propellor-dev.lintian-overrides b/debian/libghc-propellor-dev.lintian-overrides
new file mode 100644
index 00000000..6f4a12f5
--- /dev/null
+++ b/debian/libghc-propellor-dev.lintian-overrides
@@ -0,0 +1,2 @@
+# merged with Debian changelog
+no-upstream-changelog
diff --git a/debian/libghc-propellor-doc.lintian-overrides b/debian/libghc-propellor-doc.lintian-overrides
new file mode 100644
index 00000000..6f4a12f5
--- /dev/null
+++ b/debian/libghc-propellor-doc.lintian-overrides
@@ -0,0 +1,2 @@
+# merged with Debian changelog
+no-upstream-changelog
diff --git a/debian/libghc-propellor-prof.links b/debian/libghc-propellor-prof.links
new file mode 100644
index 00000000..3c2bbb38
--- /dev/null
+++ b/debian/libghc-propellor-prof.links
@@ -0,0 +1 @@
+/usr/share/doc/libghc-propellor-prof/changelog.Debian.gz /usr/share/doc/libghc-propellor-prof/changelog.gz
diff --git a/debian/libghc-propellor-prof.lintian-overrides b/debian/libghc-propellor-prof.lintian-overrides
new file mode 100644
index 00000000..6f4a12f5
--- /dev/null
+++ b/debian/libghc-propellor-prof.lintian-overrides
@@ -0,0 +1,2 @@
+# merged with Debian changelog
+no-upstream-changelog
diff --git a/debian/lintian-overrides b/debian/lintian-overrides
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/debian/lintian-overrides
diff --git a/debian/patches/0001-remove-README.Debian-from-propellor.cabal.patch b/debian/patches/0001-remove-README.Debian-from-propellor.cabal.patch
new file mode 100644
index 00000000..d28bbeb8
--- /dev/null
+++ b/debian/patches/0001-remove-README.Debian-from-propellor.cabal.patch
@@ -0,0 +1,23 @@
+From: Sean Whitton <spwhitton@spwhitton.name>
+Date: Sat, 7 May 2016 08:47:15 -0700
+Subject: remove README.Debian from propellor.cabal
+Forwarded: not-needed
+
+README.Debian has been renamed propellor.README.Debian to avoid its installation
+in /usr/share/doc/libghc-propellor-dev.
+---
+ propellor.cabal | 1 -
+ 1 file changed, 1 deletion(-)
+
+diff --git a/propellor.cabal b/propellor.cabal
+index e931e3d..6cb5a4c 100644
+--- a/propellor.cabal
++++ b/propellor.cabal
+@@ -22,7 +22,6 @@ Extra-Source-Files:
+ contrib/post-merge-hook
+ stack.yaml
+ debian/changelog
+- debian/README.Debian
+ debian/compat
+ debian/control
+ debian/copyright
diff --git a/debian/patches/series b/debian/patches/series
new file mode 100644
index 00000000..518b48b8
--- /dev/null
+++ b/debian/patches/series
@@ -0,0 +1 @@
+0001-remove-README.Debian-from-propellor.cabal.patch
diff --git a/debian/README.Debian b/debian/propellor.README.Debian
index 851add5d..851add5d 100644
--- a/debian/README.Debian
+++ b/debian/propellor.README.Debian
diff --git a/debian/propellor.docs b/debian/propellor.docs
new file mode 100644
index 00000000..2b234d90
--- /dev/null
+++ b/debian/propellor.docs
@@ -0,0 +1 @@
+doc/README.mdwn
diff --git a/debian/propellor.links b/debian/propellor.links
new file mode 100644
index 00000000..c92b1705
--- /dev/null
+++ b/debian/propellor.links
@@ -0,0 +1 @@
+/usr/share/doc/propellor/changelog.Debian.gz /usr/share/doc/propellor/changelog.gz
diff --git a/debian/propellor.lintian-overrides b/debian/propellor.lintian-overrides
new file mode 100644
index 00000000..7ce43aae
--- /dev/null
+++ b/debian/propellor.lintian-overrides
@@ -0,0 +1,6 @@
+binary-or-shlib-defines-rpath
+hardening-no-relro
+# the binary package names make the distinctions clear
+duplicate-long-description
+# the binary package names make the distinctions clear
+duplicate-short-description
diff --git a/debian/propellor.manpages b/debian/propellor.manpages
new file mode 100644
index 00000000..263e13a3
--- /dev/null
+++ b/debian/propellor.manpages
@@ -0,0 +1 @@
+propellor.1
diff --git a/debian/rules b/debian/rules
index bcb681c1..b5eea986 100755
--- a/debian/rules
+++ b/debian/rules
@@ -1,18 +1,15 @@
#!/usr/bin/make -f
+# don't install CHANGELOG as it duplicates d/changelog
+DEB_INSTALL_CHANGELOGS_ALL=-XCHANGELOG
+
# Avoid using cabal, as it writes to $HOME
export CABAL=./Setup
-%:
- dh $@
-
-override_dh_auto_build:
+build/propellor::
$(MAKE) build
-override_dh_installdocs:
- dh_installdocs doc/README.mdwn
-override_dh_installman:
- dh_installman propellor.1
+install/propellor::
+ DESTDIR=$(CURDIR)/debian/propellor $(MAKE) install
-# Not intended for use by anyone except the author.
-announcedir:
- @echo ${HOME}/src/propellor/doc/news
+include /usr/share/cdbs/1/rules/debhelper.mk
+include /usr/share/cdbs/1/class/hlibrary.mk
diff --git a/debian/source/format b/debian/source/format
new file mode 100644
index 00000000..163aaf8d
--- /dev/null
+++ b/debian/source/format
@@ -0,0 +1 @@
+3.0 (quilt)
diff --git a/debian/source/lintian-overrides b/debian/source/lintian-overrides
new file mode 100644
index 00000000..d5de3046
--- /dev/null
+++ b/debian/source/lintian-overrides
@@ -0,0 +1,5 @@
+debian-watch-may-check-gpg-signature
+# the binary package names make the distinctions clear
+duplicate-long-description
+# the binary package names make the distinctions clear
+duplicate-short-description
diff --git a/debian/source/options b/debian/source/options
new file mode 100644
index 00000000..fdf8d52d
--- /dev/null
+++ b/debian/source/options
@@ -0,0 +1 @@
+extend-diff-ignore = "(^|/)(\.cabal-sandbox|docsets|\.dir-locals\.el|cabal\.sandbox\.config)"
diff --git a/debian/watch b/debian/watch
new file mode 100644
index 00000000..2d76ff3a
--- /dev/null
+++ b/debian/watch
@@ -0,0 +1,5 @@
+# note that the tarball this watch file finds is not upstream's official release
+# tarball (which does not exist)
+
+version=3
+https://hackage.haskell.org/package/propellor /package/propellor-.+/propellor-(.+).tar.gz
diff --git a/doc/FreeBSD.mdwn b/doc/FreeBSD.mdwn
new file mode 100644
index 00000000..47b9c65b
--- /dev/null
+++ b/doc/FreeBSD.mdwn
@@ -0,0 +1,10 @@
+Propellor is in the early stages of supporting FreeBSD. It should basically
+work, and there are some modules with FreeBSD-specific properties.
+
+However, many other properties only work on a Debian Linux system, and need
+additional porting to support FreeBSD. Such properties have types like
+`Property DebianLike`. The type checker will detect and reject attempts
+to combine such properties with `Property FreeBSD`.
+
+[Sample config file](http://git.joeyh.name/?p=propellor.git;a=blob;f=config-freebsd.hs)
+which configures a FreeBSD system, as well as a Linux one.
diff --git a/doc/Linux.mdwn b/doc/Linux.mdwn
new file mode 100644
index 00000000..00276f69
--- /dev/null
+++ b/doc/Linux.mdwn
@@ -0,0 +1,9 @@
+Propellor was written to manage Linux systems.
+It supports Debian and Debian-derived distributions.
+
+Support for other distributions should not be too hard to add.
+Indeed, Propellor has been ported to [[FreeBSD]] now!
+See [[forum/Supported_OS]] for porting tips.
+
+Note that you can run Propellor on a OSX laptop and have it manage Linux
+and other systems.
diff --git a/doc/README.mdwn b/doc/README.mdwn
index a0742f78..31d222c1 100644
--- a/doc/README.mdwn
+++ b/doc/README.mdwn
@@ -2,12 +2,15 @@
configuration management system using Haskell and Git.
Each system has a list of properties, which Propellor ensures
are satisfied.
+[Linux](http://propellor.branchable.com/Linux/) and
+[FreeBSD](http://propellor.branchable.com/FreeBSD/) are supported.
Propellor is configured via a git repository, which typically lives
in `~/.propellor/` on your development machine. Propellor clones the
repository to each host it manages, in a
-[secure](http://propellor.branchable.com/security/) way. The git repository
-contains the full source code to Propellor, along with its config file.
+[secure](http://propellor.branchable.com/security/) way. See
+[components](http://propellor.branchable.com/components/)
+for details.
Properties are defined using Haskell. Edit `~/.propellor/config.hs`
to get started. There is fairly complete
@@ -35,36 +38,19 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask
## quick start
-1. Get propellor installed
+1. Get propellor installed on your development machine (ie, laptop).
`cabal install propellor`
or
`apt-get install propellor`
-2. Run propellor for the first time. It will set up a `~/.propellor/` git
+2. Run `propellor --init` ; this will set up a `~/.propellor/` git
repository for you.
-3. If you don't have a gpg private key already, generate one: `gpg --gen-key`
-4. Run: `propellor --add-key $KEYID`, which will make propellor trust
- your gpg key, and will sign your `~/.propellor` repository using it.
-5. Push the git repository to a central server (github or your own):
- `cd ~/.propellor/; git remote add origin ssh://git.example.com/propellor.git; git push -u origin master`
-6. Edit `~/.propellor/config.hs`, and add a host you want to manage.
+3. Edit `~/.propellor/config.hs`, and add a host you want to manage.
You can start by not adding any properties, or only a few.
-7. Pick a host and run: `propellor --spin $HOST`
-8. Now you have a simple propellor deployment, but it doesn't do
- much to the host yet, besides installing propellor.
-
- So, edit `~/.propellor/config.hs` to configure the host (maybe
- start with a few simple properties), and re-run step 7.
- Repeat until happy and move on to the next host. :)
-9. To move beyond manually running `propellor --spin` against hosts
- when you change their properties, add a property to your hosts
- like: `Cron.runPropellor "30 * * * *"`
-
- Now they'll automatically update every 30 minutes, and you can
- `git commit -S` and `git push` changes that affect any number of
- hosts.
-10. Write some neat new properties and send patches!
-
-## debugging
-
-Set `PROPELLOR_DEBUG=1` to make propellor print out all the commands it runs
-and any other debug messages that Properties choose to emit.
+4. Run: `propellor --spin $HOST`
+5. Now you have a simple propellor deployment to a host. Continue editing
+ `~/.propellor/config.hs` to further configure the host, add more hosts
+ etc, and re-run `propellor --spin $HOST` after each change.
+6. Once you have a lot of hosts, and running `propellor --spin HOST` for
+ each host becomes tiresome, you can
+ [automate that](http://propellor.branchable.com/automated_spins/).
+7. Write some neat new properties and send patches!
diff --git a/doc/automated_spins.mdwn b/doc/automated_spins.mdwn
new file mode 100644
index 00000000..34f04683
--- /dev/null
+++ b/doc/automated_spins.mdwn
@@ -0,0 +1,127 @@
+Once you have several hosts managed with propellor, you'll probably find
+yourself making changes to config.hs, that might affect multiple hosts.
+
+You can manually run `propellor --spin $HOST` for each affected host in
+turn. But that can get old. Time to automate it.
+
+There are two approaches you can follow:
+
+* Set up a centralized git repository, and make your hosts
+ check it for updates using cron. Then you can `git commit -S`
+ and `git push` changes that affect any number of hosts.
+
+* Set up a conductor host. When propellor is run on this host,
+ it will automatically spin the other hosts.
+
+We'll start with a centralized git repository and cron, because that's
+the easiest thing to set up, and it's a good idea to have one as a backup.
+Especially if you have co-maintainers, you'll obviously want to use
+a centralized repository to allow collaboration.
+
+## where to put the central repository
+
+The central repository does not need to be trusted; it can be hosted
+anywhere, and propellor will only accept verified gpg signed git commits
+from it. See [[security]] for details, but this means you can put it
+on github without github being able to 0wn your propellor driven hosts, for
+example.
+
+Or, you can just add some properties to one of your hosts to make it
+serve the central repository. Using `Propellor.Property.Git.daemonRunning`
+for example.
+
+## how to set up the central repository
+
+You can add a central git repository to your existing propellor setup easily:
+
+1. Push propellor's git repository to a central server (github or your own):
+ `cd ~/.propellor/; git remote add origin ssh://git.example.com/propellor.git; git push -u origin master`
+
+2. Configure the url your hosts should use for the git repository, if
+ it differs from the url above, by setting up a remote named "deploy":
+ `cd ~/.propellor/; git remote add deploy git://git.example.com/propellor.git`
+
+3. Add a crom job property to your hosts, which will make them periodically
+ check for changes that were committed to the central repository:
+ `Cron.runPropellor (Cron.Times "*/30 * * * *")`
+
+4. Let your hosts know about the changed configuration (including the url
+ to the central repository), by running `propellor --spin $HOST` for each
+ of your hosts.
+
+Now the hosts will automatically update every 30 minutes, and you can
+`git commit -S` and `git push` changes that affect any number of
+hosts.
+
+## setting up a conductor host
+
+When propellor is run on a conductor host, it will automatically
+spin some other hosts.
+
+Using a conductor host has many benefits over a centralized git
+repository and cron:
+
+* Private data, set with `propellor --set`, is gpg encrypted, and
+ hosts cannot decrypt it when their cron job pulls changes from
+ the central repository. So after updating the private data of a host,
+ you still need to manually run `propellor --spin $HOST`. A conductor
+ avoids this problem.
+* You have to wait a while for a change you commit to be
+ deployed by cron. It would be nice to be able to run "propellor"
+ once and have it update all your hosts immediately.
+* When there's a problem, a cron job can hide it, while if you're
+ running propellor yourself, you can notice the problem more easily.
+* You might want to update hosts in a specific order. For example,
+ update your dns server last. Cron jobs can't do this, but conductors
+ can.
+
+Conductors are configured using the
+[Propellor.Property.Conductor module](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Conductor.html).
+
+If you decide to go this route, pick the host you want to make a conductor,
+and add some properties to it:
+
+ mylaptop = host "mylaptop.example.com"
+ & conducts [somehost, otherhost, lasthost]
+ & Ssh.userKeys (User "root")
+ [(SshEd25519, somelongstring)]
+
+The Ssh.userKeys is used to give the root user on the conductor a known
+ssh public key. You'll need to feed the private ssh key into propellor's
+privdata store (see [[security]]).
+
+Each of the hosts that is being conducted needs to have its ssh host key
+specified as well. This is needed so that the conductor can ssh into
+the hosts.
+
+ somehost = host "somehost.example.com"
+ -- This sets the private key as well, so it will need to
+ -- be fed into propellor's privdata store.
+ & Ssh.hostKeys hostContext [(SshEd25519, somelongstring)]
+
+ lasthost = host "lasthost.example.com"
+ -- This way indicates the public key, but doesn't change
+ -- the actual host configuration.
+ & Ssh.hostPubKey SshEd25519, somelongstring
+
+Also, make this change:
+
+ - main = defaultMain hosts
+ + main = defaultMain (orchestrate hosts)
+
+Give each of the hosts you changed one last manual --spin, to set
+things up for the conductor.
+
+Now you're ready to use the conductor. When you spin the conductor
+host, it will in turn spin each of the hosts it's conducting.
+
+This simple conductor configuration can be easily adapted to
+better meet your needs. For example, if you have a host that should only
+be spinned once all the other hosts have successfully been updated,
+the conductor can be configured to do that:
+
+ & conducts [somehost, otherhost]
+ `before` conducts lasthost
+
+Other possibilities include chains of conductors spinning other conductors
+that spin hosts, etc.
diff --git a/doc/automated_spins/comment_1_1976b145c519b575c1b0454611036055._comment b/doc/automated_spins/comment_1_1976b145c519b575c1b0454611036055._comment
new file mode 100644
index 00000000..24298db9
--- /dev/null
+++ b/doc/automated_spins/comment_1_1976b145c519b575c1b0454611036055._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="arnaud@30aba4d9f1742050874551d3ddc55ca8694809f8"
+ nickname="arnaud"
+ subject="Spinning hosts in parallel"
+ date="2016-03-19T17:52:04Z"
+ content="""
+I just noticed the existence of this conductor property, which seems really interesting. I was trying to understand if and how it would be possible to spinning hosts in parallel. This could be done either as part of a conductor's run, e.g. by traversing the graph in parallel, or from command-line. It seems to me I could use directly `spin` or `spin'` functions to do that from forked threads or processes, with the master process doing the spin commit, but I may be overlooking some potential issues...
+"""]]
diff --git a/doc/automated_spins/comment_2_d0b3cfce5e37727f5b17c14d0f4214d2._comment b/doc/automated_spins/comment_2_d0b3cfce5e37727f5b17c14d0f4214d2._comment
new file mode 100644
index 00000000..c95ae691
--- /dev/null
+++ b/doc/automated_spins/comment_2_d0b3cfce5e37727f5b17c14d0f4214d2._comment
@@ -0,0 +1,27 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-03-19T18:49:26Z"
+ content="""
+Yes, that was the main reason to add
+[Propellor.Property.Concurrent](http://hackage.haskell.org/package/propellor-2.16.0/docs/Propellor-Property-Concurrent.html)
+
+It should be able to parallelize any properties using the combinators in
+there. Including `Propellor.Property.Conductor.conducts`
+
+For example:
+
+ conducts hostfoo `concurrently` conducts hostbar `concurrently` conducts hostbaz
+
+Or, something like this to conduct a whole list of hosts in parallel
+(have not tried to compile it, may need minor tweaking):
+
+ concurrentList (pure 10) "conduct web servers in parallel" $
+ PropList $ map toProp $ conduct webservers
+
+ webservers :: [Host]
+
+Note that concurrent output will be serialized, so you'll probably see propellor
+running live on the first host and then the ones that were conducted in the
+background will have their output dumped the console later on.
+"""]]
diff --git a/doc/automated_spins/comment_3_31fee6824f4f22f8f4fc8e77bf8f8d69._comment b/doc/automated_spins/comment_3_31fee6824f4f22f8f4fc8e77bf8f8d69._comment
new file mode 100644
index 00000000..dd2e0986
--- /dev/null
+++ b/doc/automated_spins/comment_3_31fee6824f4f22f8f4fc8e77bf8f8d69._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="arnaud@30aba4d9f1742050874551d3ddc55ca8694809f8"
+ nickname="arnaud"
+ subject="comment 3"
+ date="2016-03-19T22:10:42Z"
+ content="""
+Nice! Need to revisit latest changes to propellor as I may be missing some really cool stuff...
+"""]]
diff --git a/doc/automated_spins/comment_4_0e6a73215c72286ef0053b5d762537ab._comment b/doc/automated_spins/comment_4_0e6a73215c72286ef0053b5d762537ab._comment
new file mode 100644
index 00000000..1a031e9c
--- /dev/null
+++ b/doc/automated_spins/comment_4_0e6a73215c72286ef0053b5d762537ab._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="arnaud@30aba4d9f1742050874551d3ddc55ca8694809f8"
+ nickname="arnaud"
+ subject="comment 4"
+ date="2016-03-20T11:03:01Z"
+ content="""
+Is there a straightforward way to do that from command-line?
+"""]]
diff --git a/doc/coding_style.mdwn b/doc/coding_style.mdwn
index 64d1fb69..bf127fe0 100644
--- a/doc/coding_style.mdwn
+++ b/doc/coding_style.mdwn
@@ -2,6 +2,20 @@ If you do nothing else, avoid use of partial functions from the Prelude!
`import Utility.PartialPrelude` helps avoid this by defining conflicting
functions for all the common ones. Also avoid `!!`, it's partial too.
+The rest of this coding style is followed to keep the code in Propellor
+consistent. You don't have to follow these rules in your own config.hs, or
+in Propellor modules that you don't intend to get merged into mainstrain
+Propellor.
+
+Start a module with a comment indicating what software it provides
+properties for, and who maintains the module.
+
+ -- | Maintainer: Your Name Here <optional-email-address@example.org>
+ --
+ -- Support for the Foo daemon <https://foo.example.com/>
+
+ module Propellor.Property.Foo
+
Use tabs for indentation.
Code should make sense with any tab stop setting, but 8 space tabs are
@@ -103,7 +117,9 @@ Note for emacs users: You can put the following snippet into a file called
`.dir-locals.el` at root of propellor's source tree to use tabs for indentation:
((nil . ((indent-tabs-mode . t)
- (tab-width . 4)
+ (tab-width . 8)
(fill-column . 80)))
;; Warn about spaces used for indentation:
(haskell-mode . ((eval . (highlight-regexp "^ *")))))
+
+Also consider [haskell-tab-indent-mode](https://spwhitton.name/tech/code/haskell-tab-indent/). The standard indentation modes that come with haskell-mode do not work well with tabs for indentation. This mode works well for hacking on Propellor.
diff --git a/doc/coding_style/comment_1_86e860c6ac600b15b8a84cc7de1880cf._comment b/doc/coding_style/comment_1_86e860c6ac600b15b8a84cc7de1880cf._comment
new file mode 100644
index 00000000..1df2580a
--- /dev/null
+++ b/doc/coding_style/comment_1_86e860c6ac600b15b8a84cc7de1880cf._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="pelle"
+ subject="comment 1"
+ date="2015-10-09T11:49:06Z"
+ content="""
+I am bit confused. If tabs with 8 spaces are the default, why does the example `.dir-locals.el` set tab-width to 4?
+
+Also, the examples show tabs as four spaces when rendered by ikiwiki/Markdown.
+"""]]
diff --git a/doc/coding_style/comment_2_8bc078909d29f6ae13da9cb99fa4325d._comment b/doc/coding_style/comment_2_8bc078909d29f6ae13da9cb99fa4325d._comment
new file mode 100644
index 00000000..88edabee
--- /dev/null
+++ b/doc/coding_style/comment_2_8bc078909d29f6ae13da9cb99fa4325d._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-10-10T03:03:42Z"
+ content="""
+Well, 8 is the general default, I don't know why markdown defaults to 4.
+Following this coding style should result in code that looks good at most
+tab sizes.
+
+Adjusted the .dir-locals.el to use 8 for consistency.
+"""]]
diff --git a/doc/components.mdwn b/doc/components.mdwn
new file mode 100644
index 00000000..5b47e106
--- /dev/null
+++ b/doc/components.mdwn
@@ -0,0 +1,36 @@
+Propellor is a single system, but it's made up of some logically separate
+components.
+
+* Propellor is a Haskell library. The library can be installed
+ [from hackage](http://hackage.haskell.org/package/propellor)
+ in the usual ways. It complies with the
+ [[Haskell Package Version Policy|interface_stability]].
+* `~/.propellor/` is a git repository, which contains at least your
+ `config.hs` file and a cabal file. This gets deployed to each machine
+ you manage with propellor, where it's installed as `/usr/local/propellor/`
+* There can also be a propellor command in your PATH. If you `apt-get
+ install propellor`, you'll get one installed, or `cabal install propellor`
+ will put the command in `~/.cabal/bin/propellor`. This propellor command
+ is just a wrapper; it builds and runs what you have set up in `~/.propellor/`
+
+## full .propellor repository
+
+Typically, the `~/.propellor/` git repository is set up by running the
+propellor command, or by [[cloning propellor|install]]. That makes
+the repository contain the full source code to propellor, including
+the Haskell library.
+
+So if you want to, you can edit any part of Propellor's source code.
+Don't like how a property works, or need to make it more general? Just edit
+then copy in `~/.propellor/src/Propellor/` and it will be used. See
+[[contributing]] if you want to send your improvements back.
+
+## minimal .propellor repository
+
+All that really needs to be in `~/.propellor/` though, is a `config.hs`
+file, and a cabal file. Running propellor when `~/.propellor/` doesn't exist
+will ask you if you want a minimal config, and create those files.
+
+In this configuration, when propellor is deploying itself to a new host,
+it will automatically install the version of the propellor library
+specified in the cabal file.
diff --git a/doc/contributing.mdwn b/doc/contributing.mdwn
index 84aa5d64..e75784df 100644
--- a/doc/contributing.mdwn
+++ b/doc/contributing.mdwn
@@ -17,3 +17,7 @@ Propellor has its own [[coding_style]], which you are encouraged to follow
-- at least when you want to get a patch merged into propellor.
When writing code for your own internal use, feel free to ignore all the
rules, except the ones about avoiding partial functions.
+
+Also, mainline Propellor aims to be buildable with the version of ghc
+shipped in Debian stable. And, additional weighty dependencies are best
+avoided.
diff --git a/doc/debugging.mdwn b/doc/debugging.mdwn
new file mode 100644
index 00000000..acceca86
--- /dev/null
+++ b/doc/debugging.mdwn
@@ -0,0 +1,7 @@
+Set `PROPELLOR_DEBUG=1` in the environment, or `git config propellor.debug 1`
+to make propellor print out all the commands it runs and any other debug
+messages that Properties choose to emit.
+
+Another handy debugging tip is to load up your config.hs in ghci, and look
+at `hosts`. This will show the Properties of a Host, as well as the Info
+associated with it, etc.
diff --git a/doc/documentation.mdwn b/doc/documentation.mdwn
new file mode 100644
index 00000000..b4825ada
--- /dev/null
+++ b/doc/documentation.mdwn
@@ -0,0 +1,15 @@
+The [API documentation](http://hackage.haskell.org/package/propellor) of
+Propellor's modules is the most important documentation of propellor.
+
+Other documentation:
+
+* [[man page|usage]]
+* [[Haskell Newbie]]
+* [[Writing Properties]]
+* [[Automated Spins]] (and centralized git repositories)
+* [[Components]]
+* [[Contributing]]
+* [[Interface Stability]]
+* [[Coding Style]]
+* [[Security]]
+* [[Debugging]]
diff --git a/doc/feeds.mdwn b/doc/feeds.mdwn
new file mode 100644
index 00000000..583f6c39
--- /dev/null
+++ b/doc/feeds.mdwn
@@ -0,0 +1,4 @@
+Aggregating propellor blog posts etc..
+
+* [[!aggregate expirecount=25 name="joey" feedurl="http://joeyh.name/blog/propellor/index.rss" url="http://joeyh.name/blog/propellor/"]]
+
diff --git a/doc/footer/column_a.mdwn b/doc/footer/column_a.mdwn
new file mode 100644
index 00000000..e3a8b383
--- /dev/null
+++ b/doc/footer/column_a.mdwn
@@ -0,0 +1,12 @@
+## [[news]]
+
+[[!inline feeds=no template=bare pages=news]]
+
+## enjoy
+
+Hope you find Propellor fun and useful!
+
+Propellor is free software, licensed under the BSD license.
+
+You are encouraged to send patches and improve it.
+See [[contributing]].
diff --git a/doc/footer/column_b.mdwn b/doc/footer/column_b.mdwn
new file mode 100644
index 00000000..a36ca85b
--- /dev/null
+++ b/doc/footer/column_b.mdwn
@@ -0,0 +1,3 @@
+## [[posts]]
+
+[[!inline feeds=no template=bare pages=posts]]
diff --git a/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file.mdwn b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file.mdwn
new file mode 100644
index 00000000..b678d8d0
--- /dev/null
+++ b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file.mdwn
@@ -0,0 +1,34 @@
+Hello,
+
+Still working on the reprepro property :)
+
+Here A property that I am using to publish a repository via apache (this is a prototype)
+
+ website :: String -> Property
+ website hn = toProp $ Apache.siteEnabled hn apachecfg
+ where
+ apachecfg = [ "<VirtualHost *>"
+ , "DocumentRoot " ++ basePath
+ , "<Directory " ++ basePath ++ ">"
+ , " Options Indexes FollowSymLinks Multiviews"
+ , " Order allow,deny"
+ , Apache.allowAll
+ , "</Directory>"
+ ] ++ concatMap deny ["db", "conf", "incoming"]
+ ++ ["</VirtualHost>"]
+
+ deny dir = [ "<Directory \"" ++ basePath ++ "apt/*/" ++ dir ++ "\">"
+ , " Order deny,allow"
+ , " Deny from all"
+ , "</Directory>"
+ ]
+
+during my test I am runing the config.hs with
+runhaskell config.hs (it work the first time, the apache config files are ok)
+
+but when I do a modification on the apachecfg and rerun the runhaskell,
+the config files are not updated. I need to remove them to have an updated version.
+
+cheers
+
+Fred
diff --git a/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_1_932ba6f4e444c99d8d561149d17c8fe7._comment b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_1_932ba6f4e444c99d8d561149d17c8fe7._comment
new file mode 100644
index 00000000..0101ccb2
--- /dev/null
+++ b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_1_932ba6f4e444c99d8d561149d17c8fe7._comment
@@ -0,0 +1,30 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="first run"
+ date="2014-12-08T09:31:46Z"
+ content="""
+root@mordor:~/propellor/src# PROPELLOR_DEBUG=1 runhaskell config.hs
+[2014-12-08 10:27:10 CET] read: hostname [\"-f\"]
+[2014-12-08 10:27:10 CET] command line: Run \"mordor\"
+[2014-12-08 10:27:10 CET] read: git [\"remote\"]
+[2014-12-08 10:27:10 CET] read: git [\"symbolic-ref\",\"--short\",\"HEAD\"]
+[2014-12-08 10:27:10 CET] call: git [\"fetch\"]
+Pull from central git repository ... done
+[2014-12-08 10:27:12 CET] read: git [\"show-ref\",\"--hash\",\"master\"]
+[2014-12-08 10:27:12 CET] read: git [\"show-ref\",\"--hash\",\"master\"]
+mordor has Operating System (Debian Unstable) \"i386\" ... ok
+[2014-12-08 10:27:12 CET] read: apt-cache [\"policy\",\"etckeeper\"]
+mordor apt installed etckeeper ... ok
+[2014-12-08 10:27:13 CET] read: apt-cache [\"policy\",\"ssh\"]
+mordor apt installed ssh ... ok
+[2014-12-08 10:27:13 CET] read: passwd [\"-S\",\"root\"]
+mordor root has password ... ok
+[2014-12-08 10:27:13 CET] call: a2query [\"-q\",\"-s\",\"reprepro\"]
+[2014-12-08 10:27:14 CET] read: apt-cache [\"policy\",\"apache2\"]
+[2014-12-08 10:27:14 CET] call: a2ensite [\"--quiet\",\"reprepro\"]
+Enabling site reprepro.
+[2014-12-08 10:27:15 CET] call: sh [\"-c\",\"set -e ; service 'apache2' reload >/dev/null 2>&1 || true\"]
+mordor create reprepro ... done
+mordor overall ... done
+
+"""]]
diff --git a/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_2_5323336b92d9aef5a9021b924029f3af._comment b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_2_5323336b92d9aef5a9021b924029f3af._comment
new file mode 100644
index 00000000..85a57383
--- /dev/null
+++ b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_2_5323336b92d9aef5a9021b924029f3af._comment
@@ -0,0 +1,38 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="second run with content modified"
+ date="2014-12-08T09:37:43Z"
+ content="""
+Second run after adding a space here
+
+ - , \" Options Indexes FollowSymLinks Multiviews\"
+ + , \" Options Indexes FollowSymLinks Multiviews\"
+
+
+ root@mordor:~/propellor/src# PROPELLOR_DEBUG=1 runhaskell config.hs
+ [2014-12-08 10:34:19 CET] read: hostname [\"-f\"]
+ [2014-12-08 10:34:19 CET] command line: Run \"mordor\"
+ [2014-12-08 10:34:19 CET] read: git [\"remote\"]
+ [2014-12-08 10:34:19 CET] read: git [\"symbolic-ref\",\"--short\",\"HEAD\"]
+ [2014-12-08 10:34:19 CET] call: git [\"fetch\"]
+ remote: Counting objects: 32, done.
+ remote: Compressing objects: 100% (6/6), done.
+ remote: Total 6 (delta 3), reused 0 (delta 0)
+ Dépaquetage des objets: 100% (6/6), fait.
+ Depuis git://git.kitenet.net/propellor
+ c5a8cae..9ac0dfb master -> origin/master
+ Pull from central git repository ... done
+ [2014-12-08 10:34:20 CET] read: git [\"show-ref\",\"--hash\",\"master\"]
+ [2014-12-08 10:34:20 CET] read: git [\"show-ref\",\"--hash\",\"master\"]
+ mordor has Operating System (Debian Unstable) \"i386\" ... ok
+ [2014-12-08 10:34:20 CET] read: apt-cache [\"policy\",\"etckeeper\"]
+ mordor apt installed etckeeper ... ok
+ [2014-12-08 10:34:21 CET] read: apt-cache [\"policy\",\"ssh\"]
+ mordor apt installed ssh ... ok
+ [2014-12-08 10:34:21 CET] read: passwd [\"-S\",\"root\"]
+ mordor root has password ... ok
+ [2014-12-08 10:34:21 CET] call: a2query [\"-q\",\"-s\",\"reprepro\"]
+ mordor create reprepro ... ok
+ mordor overall ... ok
+
+"""]]
diff --git a/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_3_531c2c5e78fb5c62e54d84231b129dc8._comment b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_3_531c2c5e78fb5c62e54d84231b129dc8._comment
new file mode 100644
index 00000000..5dc67fb0
--- /dev/null
+++ b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_3_531c2c5e78fb5c62e54d84231b129dc8._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 3"
+ date="2014-12-08T10:47:59Z"
+ content="""
+I forgot to say that the content of
+
+/etc/apache2/site-xxx/reprepro[.conf]
+
+is unmodifed after this second run
+"""]]
diff --git a/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_4_54281604c588a7229f9d987e8cdee802._comment b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_4_54281604c588a7229f9d987e8cdee802._comment
new file mode 100644
index 00000000..a9201541
--- /dev/null
+++ b/doc/forum/Apache.siteEnabled_doesn_not_update_the_apache_config_file/comment_4_54281604c588a7229f9d987e8cdee802._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2014-12-09T04:35:12Z"
+ content="""
+Pretty obvious why if you look at the code:
+
+ enable = check (not <$> isenabled) $
+ cmdProperty "a2ensite" ["--quiet", hn]
+ `describe` ("apache site enabled " ++ hn)
+ `requires` siteAvailable hn cf
+
+So that property was skipped entirely if the site was already enabled and never looked at the config file.
+
+I've put in a fix.
+"""]]
diff --git a/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key.mdwn b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key.mdwn
new file mode 100644
index 00000000..cabf6ed5
--- /dev/null
+++ b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key.mdwn
@@ -0,0 +1,23 @@
+After adding a new key with
+
+ ssh-keygen -C '' -N '' -f ssh_host_ed25519_key -t ed25519
+
+And making propellor aware of this with the property
+
+ Ssh.hostKeys "myhost" [ (SshEd25519, "ssh-ed25519 ...") ]
+
+and running
+
+ cat ssh_host_ed25519_key | propellor --set 'SshPrivKey SshEd25519 ""' 'myhost'
+ propellor --spin myhost
+
+I got the following error in my auth.log:
+
+ error: Could not load host key: /etc/ssh/ssh_host_ed25519_key
+
+after adding a newline at the end of /etc/ssh/ssh_host_ed25519_key, everything works well...
+
+Is that a bug in propellor?
+
+
+
diff --git a/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_1_a5fdd6df5bcfab832aa1721cad139de8._comment b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_1_a5fdd6df5bcfab832aa1721cad139de8._comment
new file mode 100644
index 00000000..080c9bc1
--- /dev/null
+++ b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_1_a5fdd6df5bcfab832aa1721cad139de8._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 1"
+ date="2015-09-10T09:12:15Z"
+ content="""
+Any idea? This is quite annoying, as ssh_host_ed25519_key becomes unusable without a newline at the end of the file... Looking at Utility.PartialPrelude.readish, may it be the root of the issue?
+"""]]
diff --git a/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_2_0197951e17a4a47cce74ce6cc4108d50._comment b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_2_0197951e17a4a47cce74ce6cc4108d50._comment
new file mode 100644
index 00000000..284fafbc
--- /dev/null
+++ b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_2_0197951e17a4a47cce74ce6cc4108d50._comment
@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-09-10T21:00:46Z"
+ content="""
+If you look at `setPrivDataTo`, it explicitly chomps all trailing newlines
+from the value. I think that I did that because it's easy to accidentially
+add a newline you don't want when eg, pasting in a password.
+
+So, one solution might be to make --set --from-file load
+a file into privdata as-is. But, that seems like complication;
+you'd need to remember when to use it.
+
+I think it's better for the ssh property (and any other affected
+properties) to be changed, to add a final newline to the value from
+privdata when one is missing. Does this problem only affect ed25519
+keys, or others too? Only private keys or also public?
+
+I am currently extremely busy, so a patch would be great.
+"""]]
diff --git a/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_3_1f6fdf9c03705665b3d7d1a562dfc2e2._comment b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_3_1f6fdf9c03705665b3d7d1a562dfc2e2._comment
new file mode 100644
index 00000000..f18273f2
--- /dev/null
+++ b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_3_1f6fdf9c03705665b3d7d1a562dfc2e2._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 3"
+ date="2015-09-12T14:41:33Z"
+ content="""
+I'm not sure for the other key types, it affects ed25519 private keys (but not public keys), and apparently not rsa keys... But I'm not sure what other properties (present or future) would be affected: that seems like an ugly hack :(.
+
+Why not just removing the chomping stuff from setPrivDataTo? Pasting a password, pressing <enter>, and then <ctrl-D> is obviously different from pasting a password and pressing <ctrl-D>. Maybe another solution would be to print a warning with this information (\"do not press <enter>\" before <ctrl-D> unless you want to have a newline in your privdata\")?
+"""]]
diff --git a/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_4_38e533c398521a2f1e02fde939f753e1._comment b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_4_38e533c398521a2f1e02fde939f753e1._comment
new file mode 100644
index 00000000..e51c5147
--- /dev/null
+++ b/doc/forum/Could_not_load_host_key:___47__etc__47__ssh__47__ssh__95__host__95__ed25519__95__key/comment_4_38e533c398521a2f1e02fde939f753e1._comment
@@ -0,0 +1,35 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2015-09-15T00:29:47Z"
+ content="""
+I've fixed this bug. I thought about adding a type based
+validation when privdata is being set, but in the end decided against it
+for a couple reasons:
+
+* Doesn't fix existing privdata files.
+* The privdata file could be edited by the user, etc and the validation
+ wouldn't be run.
+* A user could just as well paste in a file and omit pasting the trailing
+ newline, so the validation would need to check if there was a trailing
+ newline when it's significant.
+* If the validation is by what the type of privdata is used for, this
+ disconnects the validation from the property that consumes the privdata.
+ Seems better to centralize all handling of a particular peice of privdata
+ in once place.
+* I was having some difficulty implementing it..
+
+Instead, I settled on making PrivData a newtype,
+and adding some accessor functions for it:
+
+ privDataLines :: PrivData -> [String]
+ privDataVal :: PrivDara -> String -- returned string never contains newlines
+
+This helps document the issue, and like `lines "a"` is the same as `lines
+"a\n"`, using privDataLines will give the same result whether the trailing
+newline was chomped or not. So, propellor no longer removes trailing newlines
+when the user is inputting privdata.
+
+The ssh property is adjusted to use privDataLines and add a trailing
+newline when writing files, and problem solved.
+"""]]
diff --git a/doc/forum/Dry_run_mode.mdwn b/doc/forum/Dry_run_mode.mdwn
new file mode 100644
index 00000000..d6f74d5f
--- /dev/null
+++ b/doc/forum/Dry_run_mode.mdwn
@@ -0,0 +1,3 @@
+Does propellor have a dry run mode? I'm not sure I trust either it or myself enough to let it make changes without checking them first!
+
+I looked in the manual page etc and tried grepping the source for likely names but couldn't find anything.
diff --git a/doc/forum/Dry_run_mode/comment_1_eb7b8e8b3259b0510e5551bcf1694ad1._comment b/doc/forum/Dry_run_mode/comment_1_eb7b8e8b3259b0510e5551bcf1694ad1._comment
new file mode 100644
index 00000000..9d95643c
--- /dev/null
+++ b/doc/forum/Dry_run_mode/comment_1_eb7b8e8b3259b0510e5551bcf1694ad1._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-10T03:02:15Z"
+ content="""
+Propellor does not have a dry run mode.
+"""]]
diff --git a/doc/forum/Dry_run_mode/comment_2_cb54f6fcc8e69af4eda4abce4ec4ab45._comment b/doc/forum/Dry_run_mode/comment_2_cb54f6fcc8e69af4eda4abce4ec4ab45._comment
new file mode 100644
index 00000000..c9b40700
--- /dev/null
+++ b/doc/forum/Dry_run_mode/comment_2_cb54f6fcc8e69af4eda4abce4ec4ab45._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://www.joachim-breitner.de/"
+ nickname="nomeata"
+ subject="Dry run mode"
+ date="2015-10-20T21:57:34Z"
+ content="""
+What I would do (or rather, what I was just attempting to do) is to attach all your properties to a container (Docker or Systemd) and inspect the container. If you like what has happened, then you can try it on the real hosts.
+
+Not as nices as a real dry-run mode, but it’s a start.
+"""]]
diff --git a/doc/forum/Embedding_configuration_files_using_Template_Haskell.mdwn b/doc/forum/Embedding_configuration_files_using_Template_Haskell.mdwn
new file mode 100644
index 00000000..11abe93b
--- /dev/null
+++ b/doc/forum/Embedding_configuration_files_using_Template_Haskell.mdwn
@@ -0,0 +1,24 @@
+I want to replace configuration file contents using Propellor, but some configuration files are long so I want to keep them outside config.hs and without having to use quotation. I came up with this:
+
+```
+{-# LANGUAGE TemplateHaskell #-}
+module Utility.Embed where
+
+import Language.Haskell.TH
+import qualified Data.FileEmbed as FE
+
+sourceFile :: FilePath -> Q Exp
+sourceFile path = return . AppE (VarE 'lines) =<< FE.embedStringFile path
+```
+
+Which can be used like this:
+
+```
+standardSystem :: HostName -> Host
+standardSystem hn = host hn
+ & Apt.installed ["heimdal-clients"]
+ & "/etc/krb5.conf" `File.hasContent`
+ $(sourceFile "files/etc/krb5.conf")
+```
+
+What do you think, is this the right approach or should I just read source files with the IO monad?
diff --git a/doc/forum/Embedding_configuration_files_using_Template_Haskell/comment_1_ae847dfeb6691034adf4a05f3e55a646._comment b/doc/forum/Embedding_configuration_files_using_Template_Haskell/comment_1_ae847dfeb6691034adf4a05f3e55a646._comment
new file mode 100644
index 00000000..377f9360
--- /dev/null
+++ b/doc/forum/Embedding_configuration_files_using_Template_Haskell/comment_1_ae847dfeb6691034adf4a05f3e55a646._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-06T18:58:23Z"
+ content="""
+I think this is fine if you want to do it that way, and it's nice how
+short and simple the code is!
+
+If you wanted to add this as a patch in mainline propellor, I'd need to
+think about whether it makes sense to require working TH support to build
+propellor. I guess all the systems I personally run propellor on now,
+including the arm ones, have working TH, but there are certianly linux
+architectures that don't support TH yet.
+
+A build flag might be an option. Or, keep it in your local configuration,
+since it is quite short-n-sweet.
+"""]]
diff --git a/doc/forum/Embedding_configuration_files_using_Template_Haskell/comment_2_4d2b5f37e1f6cff806bb270d38c22f98._comment b/doc/forum/Embedding_configuration_files_using_Template_Haskell/comment_2_4d2b5f37e1f6cff806bb270d38c22f98._comment
new file mode 100644
index 00000000..09fd9ee7
--- /dev/null
+++ b/doc/forum/Embedding_configuration_files_using_Template_Haskell/comment_2_4d2b5f37e1f6cff806bb270d38c22f98._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="pelle"
+ subject="comment 2"
+ date="2015-10-09T08:06:18Z"
+ content="""
+In that case, I will probably create a regular property for copying file contents. It seemed like a neat solution, but if it's not available everywhere I don't think it's worth it. I've also heard that there are problems with TH so it might be best to avoid it unless there is a compelling reason to use it.
+
+I'm also thinking about using Data.Text.Template to template configuration files. With TH, the templates could be compiled and error-checked during build-time, kind of like what Yesod does. But again, I don't think it's worth the trouble.
+"""]]
diff --git a/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs.mdwn b/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs.mdwn
new file mode 100644
index 00000000..e11f5010
--- /dev/null
+++ b/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs.mdwn
@@ -0,0 +1,3 @@
+I'm not experienced haskeller, but I've started to work on augeas property for propellor. I've created a separate repo for it: https://github.com/paluh/propellor-augeas. I will try to rewrite some existing properties on top of this and add some new. It is in a really early stage, but it works.
+
+I think that it will be a lot easier to work on propellor core properties and features, if it will be separated lib without any "spinning" abilities. Currently when I'm trying to read your or my commits history, there is a lot of "propellor spin" commits, without any sensible comment. In addition, it is hard to merge any changes to your repo - I can't just send you pull request. In case of such a broad project as propellor, I think that it will be beneficial to facilitate cooperation and to separate deployment mechanics from core configuration management parts. What do you think about extracting pure library from existing project?
diff --git a/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_1_ae5bb6438981259673e07b7185367b43._comment b/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_1_ae5bb6438981259673e07b7185367b43._comment
new file mode 100644
index 00000000..2b88da6b
--- /dev/null
+++ b/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_1_ae5bb6438981259673e07b7185367b43._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-06-29T20:43:24Z"
+ content="""
+This seems like it would be a useful addition to propellor.
+
+As to commits made by propellor --spin during development, those typically
+involve changes to my own configuration, or minor changes, but sometimes
+other changes slip into one of those commits during the press of sysadmin
+events. I doh't see how those would prevent you from sending patches though.
+"""]]
diff --git a/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_2_51249fd1eb1d0eb553c229df775fb7ee._comment b/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_2_51249fd1eb1d0eb553c229df775fb7ee._comment
new file mode 100644
index 00000000..aedebfae
--- /dev/null
+++ b/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_2_51249fd1eb1d0eb553c229df775fb7ee._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2015-09-25T13:27:54Z"
+ content="""
+Do we know if this augeas module could be integrated into Propellor ?
+"""]]
diff --git a/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_3_a1f7f5da5f01df715173294e83af0e10._comment b/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_3_a1f7f5da5f01df715173294e83af0e10._comment
new file mode 100644
index 00000000..68061720
--- /dev/null
+++ b/doc/forum/Experimental_propellor_augeas_intergration_+_workflow_concenrs/comment_3_a1f7f5da5f01df715173294e83af0e10._comment
@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-09-25T13:37:34Z"
+ content="""
+I'm generally happy to accept new modules into propellor. However, this one
+is problimatic since it adds several new dependencies. I want to keep
+propellor's dependencies minimal.
+
+It could be integrated behind a flag in propellor.cabal, but then I'd need
+to worry about testing it (or not testing it) for integration when there
+are changes.
+
+So, maybe this works better as an addon module? A propellor user could then
+add it to their config.hs. Only problem I see is, it currently depends on
+propellor, so a user can't modify their propellor.cabal to depend on it.
+So you'd have to use propellor as a library.
+"""]]
diff --git a/doc/forum/Fail_to_push_changes_when_merging.mdwn b/doc/forum/Fail_to_push_changes_when_merging.mdwn
new file mode 100644
index 00000000..62bb314d
--- /dev/null
+++ b/doc/forum/Fail_to_push_changes_when_merging.mdwn
@@ -0,0 +1,27 @@
+I use a single propellor configuration repository shared across multiple hosts, but we don't have a central repository, e.g. we don't set origin on master branch so propellor do not push/pull from central repository when updating. That works fine as long as we do not merge branches. When we do we encounter the following error:
+
+ remote: Counting objects: 108, done.
+ remote: Compressing objects: 100% (105/105), done.
+ remote: Total 108 (delta 53), reused 0 (delta 0) s
+ Receiving objects: 100% (108/108), 41.16 KiB | 22.00 KiB/s, done.
+ Resolving deltas: 100% (53/53), completed with 19 local objects.
+ From .
+ * branch HEAD -> FETCH_HEAD
+
+ *** Please tell me who you are.
+
+ Run
+
+ git config --global user.email "you@example.com"
+ git config --global user.name "Your Name"
+
+ to set your account's default identity.
+ Omit --global to set the identity only in this repository.
+
+ fatal: unable to auto-detect email address (got 'root@lending-test.(none)')
+ propellor: <stdout>: hIsTerminalDevice: illegal operation (handle is closed)
+
+I do not understand properly how propellor does propagate changes in this case so I am unable to fix this issue in a sane way. What we currently do is simply log in in the server and wipe out propellor repo there, which works but kind of defeat the whole purpose of automated configuration management.
+
+Could you please advise on how we can fix this issue? Simply having a central repository would do the trick I guess, but is there another solution?
+
diff --git a/doc/forum/Fail_to_push_changes_when_merging/comment_1_a44e03cbce4c996e136f917d8e06a7bb._comment b/doc/forum/Fail_to_push_changes_when_merging/comment_1_a44e03cbce4c996e136f917d8e06a7bb._comment
new file mode 100644
index 00000000..751d701a
--- /dev/null
+++ b/doc/forum/Fail_to_push_changes_when_merging/comment_1_a44e03cbce4c996e136f917d8e06a7bb._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 1"
+ date="2015-12-08T01:20:26Z"
+ content="""
+It looks like git is failing because it can't autodetect an e-mail address for root on the target machine. This might be because the target machine does not have a FQDN, but I'm not sure. Try logging into the target machine as root and running
+
+ git config --global user.email root@lending-test.local
+ git config --global user.name root
+
+as it suggests.
+"""]]
diff --git a/doc/forum/Fail_to_push_changes_when_merging/comment_2_4c8e1d9409b8ecfc465550fbbf5c0708._comment b/doc/forum/Fail_to_push_changes_when_merging/comment_2_4c8e1d9409b8ecfc465550fbbf5c0708._comment
new file mode 100644
index 00000000..47eb9f6a
--- /dev/null
+++ b/doc/forum/Fail_to_push_changes_when_merging/comment_2_4c8e1d9409b8ecfc465550fbbf5c0708._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="arnaud@30aba4d9f1742050874551d3ddc55ca8694809f8"
+ nickname="arnaud"
+ subject="comment 2"
+ date="2015-12-08T07:04:21Z"
+ content="""
+Thanks, I will try that. But why does it not happen when updating with fast-forward?
+"""]]
diff --git a/doc/forum/Fail_to_push_changes_when_merging/comment_3_bdf54ac096c994c33d661b454d89c770._comment b/doc/forum/Fail_to_push_changes_when_merging/comment_3_bdf54ac096c994c33d661b454d89c770._comment
new file mode 100644
index 00000000..a59296a0
--- /dev/null
+++ b/doc/forum/Fail_to_push_changes_when_merging/comment_3_bdf54ac096c994c33d661b454d89c770._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-12-08T15:53:27Z"
+ content="""
+Looks like a lacking FQDN indeed. There's a property to fix that! ;)
+
+Git is also picky about the user having a name.
+
+AFAIK, git does not make commits for fast-forward merges, but it does for
+non-fast-forward merges. I suspect that it's making such a merge in your
+case.
+"""]]
diff --git a/doc/forum/Formatting_struggle_with_Apt.backportSuite.mdwn b/doc/forum/Formatting_struggle_with_Apt.backportSuite.mdwn
new file mode 100644
index 00000000..350f03c9
--- /dev/null
+++ b/doc/forum/Formatting_struggle_with_Apt.backportSuite.mdwn
@@ -0,0 +1,9 @@
+I have tried what seems like all permutations possible to make
+
+ & Apt.backportSuite "Stable "jessie""
+
+work (square brackets, normal brackets, escape, combinations of all that...) but no success so far.
+
+It seems there should go a string after backportSuite, which according to what I read should be double-quoted. However, the release also needs to be double-quoted.
+
+What is the right way of doing this?
diff --git a/doc/forum/Formatting_struggle_with_Apt.backportSuite/comment_1_9d4f41976824ef29381bbd2bbb3eaf39._comment b/doc/forum/Formatting_struggle_with_Apt.backportSuite/comment_1_9d4f41976824ef29381bbd2bbb3eaf39._comment
new file mode 100644
index 00000000..99dccf58
--- /dev/null
+++ b/doc/forum/Formatting_struggle_with_Apt.backportSuite/comment_1_9d4f41976824ef29381bbd2bbb3eaf39._comment
@@ -0,0 +1,27 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-04-26T15:02:03Z"
+ content="""
+Well, `backportSuite` takes a `DebianSuite` data type, and `Stable`
+is a constructor for it. So, you don't quote the data constructor,
+but only quote the release name string passed to it:
+
+ (Stable "jessie")
+
+But, `backportSuite` is not a property, so you can't add it to a host
+with `&` anyway.
+
+If you're trying to set up a sources.list that can install backports, the
+way to do it is:
+
+ & osDebian (Stable "jessie") "amd64"
+ & Apt.stdSourcesList
+
+The standard sources.list configuration includes backports when
+the `DebianSuite` part of the host's OS is a stable release.
+
+There's also a property to install packages from backports:
+
+ & Apt.installedBackport ["somepackage"]
+"""]]
diff --git a/doc/forum/Formatting_struggle_with_Apt.backportSuite/comment_2_e4d9c8315d20dae1f0fd38c2eea208cb._comment b/doc/forum/Formatting_struggle_with_Apt.backportSuite/comment_2_e4d9c8315d20dae1f0fd38c2eea208cb._comment
new file mode 100644
index 00000000..2159ef24
--- /dev/null
+++ b/doc/forum/Formatting_struggle_with_Apt.backportSuite/comment_2_e4d9c8315d20dae1f0fd38c2eea208cb._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="frederik@ffbea6a549cb3f460d110386c0f634c1ddc6a68a"
+ nickname="frederik"
+ subject="comment 2"
+ date="2016-04-27T12:21:58Z"
+ content="""
+Thanks!
+"""]]
diff --git a/doc/forum/FreeBSD_Port.mdwn b/doc/forum/FreeBSD_Port.mdwn
new file mode 100644
index 00000000..6a184d61
--- /dev/null
+++ b/doc/forum/FreeBSD_Port.mdwn
@@ -0,0 +1,12 @@
+Hey all, I just thought I'd mention I'm working on porting Propellor to FreeBSD. Here's my [GitHub fork](https://github.com/misandrist/propellor/tree/FreeBSD), and the branch is called FreeBSD.
+
+Currently:
+
+- I've started passing the System down into the Bootstrap to choose the right shell commands and package dependencies
+- I've briefly commented out the Cron job creation
+- I've added a module for FreeBSD, and a really minimal property for Pkg
+- I've created a sample configuration which is only tests pkg update
+
+It's pretty encouraging so far, and I'm hoping to have more working soon.
+
+Thanks!
diff --git a/doc/forum/FreeBSD_Port/comment_1_ecb4253fd0cf4060cf8706c0f633a225._comment b/doc/forum/FreeBSD_Port/comment_1_ecb4253fd0cf4060cf8706c0f633a225._comment
new file mode 100644
index 00000000..a09d5cc2
--- /dev/null
+++ b/doc/forum/FreeBSD_Port/comment_1_ecb4253fd0cf4060cf8706c0f633a225._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-03-08T02:01:27Z"
+ content="""
+This has now been merged into propellor master, after quite a lot more
+improvements. See the [[FreeBSD]] page.
+"""]]
diff --git a/doc/forum/Git_repo_updating.mdwn b/doc/forum/Git_repo_updating.mdwn
new file mode 100644
index 00000000..e0cccedd
--- /dev/null
+++ b/doc/forum/Git_repo_updating.mdwn
@@ -0,0 +1 @@
+Propellor.Property.Git.cloned clones a git repo to a location, great! Is there an easy way to keep it updated afterwards, though? I guess having a property that enforce up-to-dateness wouldn't be so practical since you have to hit the remote to check, perhaps a cron job to run some equivalent of `git fetch && git reset --hard && git clean -dfx`. (Just thinking out loud here, and wondering what everyone else is doing)
diff --git a/doc/forum/Git_repo_updating/comment_1_f601e29b5fb82700b21914f3fb1ef49b._comment b/doc/forum/Git_repo_updating/comment_1_f601e29b5fb82700b21914f3fb1ef49b._comment
new file mode 100644
index 00000000..9aaa4f60
--- /dev/null
+++ b/doc/forum/Git_repo_updating/comment_1_f601e29b5fb82700b21914f3fb1ef49b._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-03-04T16:25:55Z"
+ content="""
+You could certianly write a property that did a git pull every time. It
+would do some unnessesary work and still not keep the checkout always
+immediately up-to-date.
+
+Better to have some kind of hook that causes the checkout to update when
+changes are pushed into its parent repository. How such a hook works
+depends on where the parent repository is hosted. Propellor properties
+could be written to set up whatever's needed for such a hook on the system
+where the repository is checked out. If you're hosting your own git
+server as well, propellor properties could set up the post-update hook in
+the origin repo too.
+"""]]
diff --git a/doc/forum/Git_repo_updating/comment_2_d83a481b0a82ed1ad5446010c6b88485._comment b/doc/forum/Git_repo_updating/comment_2_d83a481b0a82ed1ad5446010c6b88485._comment
new file mode 100644
index 00000000..34c93aa9
--- /dev/null
+++ b/doc/forum/Git_repo_updating/comment_2_d83a481b0a82ed1ad5446010c6b88485._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 2"
+ date="2016-03-08T02:52:40Z"
+ content="""
+In the end, I took the approach of making the thing that used the git repo update it before using it (since the use case was amenable to such a thing).
+"""]]
diff --git a/doc/forum/Locales_always_generated.mdwn b/doc/forum/Locales_always_generated.mdwn
new file mode 100644
index 00000000..769cbad0
--- /dev/null
+++ b/doc/forum/Locales_always_generated.mdwn
@@ -0,0 +1,18 @@
+I'm using the `Locale.available` property, and it seems the locales are always generated:
+
+```
+Generating locales (this might take a while)...
+ en_GB.UTF-8... done
+ en_US.UTF-8... done
+ en_ZA.UTF-8... done
+Generation complete.
+onyx.fusionapp.com en_ZA.UTF-8 locale generated ... done
+Generating locales (this might take a while)...
+ en_GB.UTF-8... done
+ en_US.UTF-8... done
+ en_ZA.UTF-8... done
+Generation complete.
+onyx.fusionapp.com en_US.UTF-8 locale generated ... done
+```
+
+I inspected the definition of the property, but I'm not sure where the bug is. Should `fileProperty` with identical contents be causing `onChange` to trigger?
diff --git a/doc/forum/Locales_always_generated/comment_1_26e9d3c1ec2ad32d18ee2205254b71b8._comment b/doc/forum/Locales_always_generated/comment_1_26e9d3c1ec2ad32d18ee2205254b71b8._comment
new file mode 100644
index 00000000..de64aaa8
--- /dev/null
+++ b/doc/forum/Locales_always_generated/comment_1_26e9d3c1ec2ad32d18ee2205254b71b8._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-03-06T17:06:16Z"
+ content="""
+What seems to be going on is, /etc/locale.gen is changed, uncommenting
+the line, but then the dpkg-reconfigure locales rewrites the file
+with the same set of locales enabled but a different set of lines and
+comments. So, next time the property runs, it wants to change the file again.
+
+I changed it to run locale-gen instead, which avoids the problem.
+"""]]
diff --git a/doc/forum/Locales_always_generated/comment_2_fcce3726ab696a55abb12367ff5bf36c._comment b/doc/forum/Locales_always_generated/comment_2_fcce3726ab696a55abb12367ff5bf36c._comment
new file mode 100644
index 00000000..67143d74
--- /dev/null
+++ b/doc/forum/Locales_always_generated/comment_2_fcce3726ab696a55abb12367ff5bf36c._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 2"
+ date="2016-03-06T17:38:57Z"
+ content="""
+Ah, nice! I hadn't noticed that the contents was actually changing.
+"""]]
diff --git a/doc/forum/Locales_always_generated/comment_3_6415ceae053e84e78140e95f5d8cafbc._comment b/doc/forum/Locales_always_generated/comment_3_6415ceae053e84e78140e95f5d8cafbc._comment
new file mode 100644
index 00000000..6c791e6c
--- /dev/null
+++ b/doc/forum/Locales_always_generated/comment_3_6415ceae053e84e78140e95f5d8cafbc._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 3"
+ date="2016-03-08T01:56:57Z"
+ content="""
+Thanks for fixing my mistake, Joey.
+"""]]
diff --git a/doc/forum/Multiple_propellor_repos.mdwn b/doc/forum/Multiple_propellor_repos.mdwn
new file mode 100644
index 00000000..7c6f4012
--- /dev/null
+++ b/doc/forum/Multiple_propellor_repos.mdwn
@@ -0,0 +1 @@
+I would like to use Propellor for work hosts as well as configuring my personal hosts, but having these in the same repository is somewhat impractical. How do I use a Propellor repository that isn't at ~/.propellor?
diff --git a/doc/forum/Multiple_propellor_repos/comment_1_7e67945e0243553b664805825a839490._comment b/doc/forum/Multiple_propellor_repos/comment_1_7e67945e0243553b664805825a839490._comment
new file mode 100644
index 00000000..ff4c6ab6
--- /dev/null
+++ b/doc/forum/Multiple_propellor_repos/comment_1_7e67945e0243553b664805825a839490._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 1"
+ date="2015-06-08T01:50:54Z"
+ content="""
+Actually, I think I figured this out; just run `make build` in the located-elsewhere repo to get `./propellor` and then run that directly.
+"""]]
diff --git a/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring.mdwn b/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring.mdwn
new file mode 100644
index 00000000..45f85767
--- /dev/null
+++ b/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring.mdwn
@@ -0,0 +1,13 @@
+ Obnam.backupEncrypted "/" (Cron.Times "44 2 * * *") [] Obnam.OnlyClient (Gpg.GpgKeyId "XXXXXX")
+
+ $ propellor --spin myhost
+ myhost apt installed obnam ... ok
+ gpg: key XXXXXX: already in secret keyring
+ gpg: Total number processed: 1
+ gpg: secret keys read: 1
+ gpg: secret keys unchanged: 1
+ ** warning: user error (su ["-c","gpg --import","root"] exited 2)
+ myhost / backed up by obnam ... failed
+ myhost overall ... failed
+ Shared connection to myhost closed.
+ propellor: remote propellor failed
diff --git a/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring/comment_1_c9a24f6022fbe9063356df3ddbd767d6._comment b/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring/comment_1_c9a24f6022fbe9063356df3ddbd767d6._comment
new file mode 100644
index 00000000..c65cc5cd
--- /dev/null
+++ b/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring/comment_1_c9a24f6022fbe9063356df3ddbd767d6._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-12-11T16:41:30Z"
+ content="""
+More accurately, it's Gpg.keyImported that's failing, and this is because
+it's implemented using a flagFile to remember if it's imported the gpg key
+before. So the fix would be to implement:
+
+ hasPrivKey :: GpgKeyId -> User -> IO Bool
+
+ hasPubKey :: GpgKeyId -> User -> IO Bool
+
+And then Gpg.keyImported could use those with `check` to avoid redundant
+import.
+"""]]
diff --git a/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring/comment_2_2300ca8616f5bd229bf7b72a6fb96980._comment b/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring/comment_2_2300ca8616f5bd229bf7b72a6fb96980._comment
new file mode 100644
index 00000000..8592e7e1
--- /dev/null
+++ b/doc/forum/Obnam.backupEncrypted_fails_if_gpg_key_is_already_in_keyring/comment_2_2300ca8616f5bd229bf7b72a6fb96980._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 2"
+ date="2015-12-13T20:45:06Z"
+ content="""
+OK, I'll try to implement something this way :).
+"""]]
diff --git a/doc/forum/PROPELLOR__95__DEBUG_doesn_not_propagate_to_the_host.mdwn b/doc/forum/PROPELLOR__95__DEBUG_doesn_not_propagate_to_the_host.mdwn
new file mode 100644
index 00000000..aa0e2537
--- /dev/null
+++ b/doc/forum/PROPELLOR__95__DEBUG_doesn_not_propagate_to_the_host.mdwn
@@ -0,0 +1,9 @@
+While investigating my rm property problem I ran propellor with
+
+ PROPELLOR_DEBUG=1 propellor
+
+At the beginning I have the debug informations but not once the ssh connection was initiated on the host.
+
+So I had to log into the host in order to run locally propellor in debug mode.
+
+It seems to me that the PROPELLOR_DEBUG=1 env should be propagate to the host, chroot etc...
diff --git a/doc/forum/PROPELLOR__95__DEBUG_doesn_not_propagate_to_the_host/comment_1_fee362df05fbdb34c22c99e2e30a4789._comment b/doc/forum/PROPELLOR__95__DEBUG_doesn_not_propagate_to_the_host/comment_1_fee362df05fbdb34c22c99e2e30a4789._comment
new file mode 100644
index 00000000..b6d3e508
--- /dev/null
+++ b/doc/forum/PROPELLOR__95__DEBUG_doesn_not_propagate_to_the_host/comment_1_fee362df05fbdb34c22c99e2e30a4789._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-02T15:21:17Z"
+ content="""
+Annoyed me a few times too, but not enough to do anything about it.
+
+It might make sense to add a command-line option to enable debug mode,
+so that propellor can pass it when it runs propellor elsewhere..
+"""]]
diff --git a/doc/forum/Problem_with_cmdProperty_and_rm.mdwn b/doc/forum/Problem_with_cmdProperty_and_rm.mdwn
new file mode 100644
index 00000000..65635fc9
--- /dev/null
+++ b/doc/forum/Problem_with_cmdProperty_and_rm.mdwn
@@ -0,0 +1,25 @@
+I am using this property in order to remove a bunch of file
+
+ cmdProperty "rm" ["-f", "-v", "/etc/schroot/chroot.d" </> (chrootname ++ "-sbuild-*")]
+
+during the process it is ok
+
+ xxx@xxxx rm -f -v /etc/schroot/chroot.d/jessie-i386-sbuild-* ... done
+
+but
+
+ ~$ ls /etc/schroot/chroot.d/jessie-i386-sbuild-*
+ /etc/schroot/chroot.d/jessie-i386-sbuild-0ClOnm /etc/schroot/chroot.d/jessie-i386-sbuild-fAxdL6 /etc/schroot/chroot.d/jessie-i386-sbuild-PG9d8D /etc/schroot/chroot.d/jessie-i386-sbuild-tweTLd
+ /etc/schroot/chroot.d/jessie-i386-sbuild-1qXV4i /etc/schroot/chroot.d/jessie-i386-sbuild-hLZtEV /etc/schroot/chroot.d/jessie-i386-sbuild-thaExp /etc/schroot/chroot.d/jessie-i386-sbuild-uJHP6m
+ /etc/schroot/chroot.d/jessie-i386-sbuild-6wSjGH /etc/schroot/chroot.d/jessie-i386-sbuild-KNUVIo /etc/schroot/chroot.d/jessie-i386-sbuild-tUcBcL /etc/schroot/chroot.d/jessie-i386-sbuild-UnfRTK
+
+So it seems that this property did not worked.
+
+So I ran propellor with PROPELLOR_DEBUG=1 and the return code of the rm command is a Success
+
+When I use a scriptProperty it works
+
+ scriptProperty
+ [ "rm -f -v " ++ "/etc/schroot/chroot.d" </> (chrootname ++ "-sbuild-*") ]
+
+So it seems that something is wrong with the cmdProperty
diff --git a/doc/forum/Problem_with_cmdProperty_and_rm/comment_1_214a68eb381b3da4a967da0a6c55d87b._comment b/doc/forum/Problem_with_cmdProperty_and_rm/comment_1_214a68eb381b3da4a967da0a6c55d87b._comment
new file mode 100644
index 00000000..99fb7697
--- /dev/null
+++ b/doc/forum/Problem_with_cmdProperty_and_rm/comment_1_214a68eb381b3da4a967da0a6c55d87b._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-02T14:49:19Z"
+ content="""
+Wildcard expansion is done by the shell, and cmdProperty does not run a
+shell. So, you've told rm to delete a
+file with a literal '*' in its name, which it's happy to report success
+with, since no such file exists..
+
+Using scriptProperty would be one way to do this.
+"""]]
diff --git a/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu.mdwn b/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu.mdwn
new file mode 100644
index 00000000..eadc9543
--- /dev/null
+++ b/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu.mdwn
@@ -0,0 +1,37 @@
+I am trying to upgrade my propellor config to latest Propellor, using it as a library. I run into the following compilation error when doing `propellor X.Y.Z.T` on my machine:
+
+```
+[17 of 65] Compiling Propellor.Property.Chroot.Util ( src/Propellor/Property/Chroot/Util.hs, dist/build/propellor-config/propellor-config-tmp/Propellor/Property/Chroot/Util.o )
+[18 of 65] Compiling Utility.UserInfo ( src/Utility/UserInfo.hs, dist/build/propellor-config/propellor-config-tmp/Utility/UserInfo.o )
+[19 of 65] Compiling Utility.Monad ( src/Utility/Monad.hs, dist/build/propellor-config/propellor-config-tmp/Utility/Monad.o )
+[20 of 65] Compiling Utility.Exception ( src/Utility/Exception.hs, dist/build/propellor-config/propellor-config-tmp/Utility/Exception.o )
+
+src/Utility/Exception.hs:65:15:
+ Not in scope: type constructor or class `MonadMask'
+Failed to install propellor-2.5.0
+Downloading MonadCatchIO-transformers-0.3.1.3...
+Configuring MonadCatchIO-transformers-0.3.1.3...
+Building MonadCatchIO-transformers-0.3.1.3...
+Preprocessing library MonadCatchIO-transformers-0.3.1.3...
+[1 of 2] Compiling Control.Monad.CatchIO ( src/Control/Monad/CatchIO.hs, dist/build/Control/Monad/CatchIO.o )
+
+src/Control/Monad/CatchIO.hs:29:1: Warning:
+ Module `Prelude' does not export `catch'
+[2 of 2] Compiling Control.Monad.CatchIO.Try ( src/Control/Monad/CatchIO/Try.hs, dist/build/Control/Monad/CatchIO/Try.o )
+caIn-place regisbaterinl:g Mon adCatchIO-transformers-0.3.1.3...
+Installing libErrorary in
+r/ro:ot/.cabal/lib/MonadCatchIO-transformers-0.3.1.3/ghc-7.6.3
+Registering MonadCatchIO-transformers-0.3.1.3...
+Installed MonadCatchIO-transformers-0.3.1.3
+ some packages failed to install:
+propellor-2.5.0 failed during the building phase. The exception was:
+ExitFailure 1
+caResolving depenbaldencies...
+Configuring prod-0.0.1..: .
+At least the following dependencies are missing:
+propellor ==2.5.0
+sh: 1: ./propellor: not found
+propellor: user error (ssh ["-o","ControlPath=/Users/arnaud/.ssh/propellor/X.Y.Z.T.sock","-o","ControlMaster=auto","-o","ControlPersist=yes","root@X.Y.Z.T","sh -c 'if [ ! -d /usr/local/propellor/.git ] ; then (if ! git --version >/dev/null; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git; fi && echo STATUSNeedGitClone) || echo STATUSNeedPrecompiled ; else cd /usr/local/propellor && if ! cabal configure >/dev/null 2>&1; then ( apt-get update ; apt-get --no-upgrade --no-install-recommends -y install gnupg ; apt-get --no-upgrade --no-install-recommends -y install ghc ; apt-get --no-upgrade --no-install-recommends -y install cabal-install ; apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-missingh-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-hslogger-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-unix-compat-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-ansi-terminal-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-ifelse-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-network-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-quickcheck2-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-mtl-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-transformers-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-exceptions-dev ; cabal update ; cabal install --only-dependencies ) || true; fi&& if ! test -x ./propellor; then cabal configure && cabal build && ln -sf dist/build/propellor-config/propellor-config propellor; fi;if test -x ./propellor && ! ./propellor --check 2>/dev/null; then cabal clean && cabal configure && cabal build && ln -sf dist/build/propellor-config/propellor-config propellor; fi && ./propellor --boot X.Y.Z.T ; fi'"] exited 127)
+```
+
+Am I missing something?
diff --git a/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu/comment_1_67f017b92670759083b73a4536183dbc._comment b/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu/comment_1_67f017b92670759083b73a4536183dbc._comment
new file mode 100644
index 00000000..0e0c7b9d
--- /dev/null
+++ b/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu/comment_1_67f017b92670759083b73a4536183dbc._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-06-30T20:51:14Z"
+ content="""
+Since MonadMask is provided by exceptions since 0.6, I guess you must have
+an olver version installed.
+
+I've versioned the dependency now.
+"""]]
diff --git a/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu/comment_2_08aa3d15e6fa9b3fb4c07fc992da4ab0._comment b/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu/comment_2_08aa3d15e6fa9b3fb4c07fc992da4ab0._comment
new file mode 100644
index 00000000..f518c502
--- /dev/null
+++ b/doc/forum/Propellor_2.5.0_does_not_build_out_of_the_box_on_newly_installed_ubuntu/comment_2_08aa3d15e6fa9b3fb4c07fc992da4ab0._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="arnaud@30aba4d9f1742050874551d3ddc55ca8694809f8"
+ nickname="arnaud"
+ subject="comment 2"
+ date="2015-07-01T07:31:03Z"
+ content="""
+I guess a workaround would be to force the version in my cabal file. I will try that.
+"""]]
diff --git a/doc/forum/Propellor_without_superuser_privileges.mdwn b/doc/forum/Propellor_without_superuser_privileges.mdwn
new file mode 100644
index 00000000..d7288a72
--- /dev/null
+++ b/doc/forum/Propellor_without_superuser_privileges.mdwn
@@ -0,0 +1,3 @@
+Joey uses propellor to popular his /home/joey on hosts he controls. I'd like to use it to populate my home directory on hosts where I don't have root. If someone gives me a shell account on a Debian box, it would be great to just run `propellor --spin` to have apply properties such as having certain stuff downloaded and compiled in `~/local/bin`, putting cronjobs in place, and checking stuff out with `myrepos`.
+
+Does propellor assume root access at a deep enough level that writing properties to do this stuff would be impractical?
diff --git a/doc/forum/Propellor_without_superuser_privileges/comment_1_021ecbb1b8bd7e26776b49ec75e90d0c._comment b/doc/forum/Propellor_without_superuser_privileges/comment_1_021ecbb1b8bd7e26776b49ec75e90d0c._comment
new file mode 100644
index 00000000..1a38ef94
--- /dev/null
+++ b/doc/forum/Propellor_without_superuser_privileges/comment_1_021ecbb1b8bd7e26776b49ec75e90d0c._comment
@@ -0,0 +1,26 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2014-12-26T19:26:00Z"
+ content="""
+I think that the root assumptions are in basically 3 places:
+
+* Many Properties assume they're run as root, and will fail if they're not.
+ Probably not a problem in practice for most of them. It might be nice
+ to make a few, such as `User.hasSomePassword` work when run as a normal
+ user.
+
+* Propellor's self-deployment involves running apt-get to instal ghc,
+ etc. This could be modified to check if it's not root and do a local
+ user of ghc if necessary.
+
+* `localdir = "/usr/local" and this is used in various places by eg,
+ `--spin`. It is, however, entirely possible to run "./propellor" in
+ some other directory, which causes it to run in that directory
+ and ensure the properties of localhost. `--spin` could certianly be
+ taught to run in a user mode where it uses "~/.propellor/" instead of
+ `localdir`.
+
+I think that's all! I don't plan to try to add this feature myself, but
+will be happy to support anyone who wants to work on it.
+"""]]
diff --git a/doc/forum/REversable_property_changes.mdwn b/doc/forum/REversable_property_changes.mdwn
new file mode 100644
index 00000000..bdad12c5
--- /dev/null
+++ b/doc/forum/REversable_property_changes.mdwn
@@ -0,0 +1,36 @@
+Hello, I just installed propellor 2.13.0 and now I get this error message.
+
+It was sort of expected due to the chnages in the API.
+I would like your advice about this problem.
+Indeed I combine Property and RevertableProperty.
+
+so what should be the best way to fix this issue.
+
+ src/Propellor/Property/Sbuild.hs:57:51:
+ Couldn't match type ‘Property (CInfo HasInfo NoInfo)’
+ with ‘RevertableProperty HasInfo’
+ Expected type: RevertableProperty HasInfo
+ Actual type: CombinedType
+ (RevertableProperty HasInfo) (Property NoInfo)
+ In the expression: (setup <!> cleanup) `requires` installed
+ In an equation for ‘schroot’:
+ schroot sn chroot@(Chroot.Chroot chrootdir _ _)
+ = (setup <!> cleanup) `requires` installed
+ where
+ setup
+ = conf `requires` (provision `onChange` targz)
+ where
+ provision
+ = toProp (Chroot.provisioned chroot) `before` umount
+ where
+ ...
+ targz = createTarball chrootdir tarball
+ ....
+ cleanup
+ = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toProp (revert (Chroot.provisioned chroot))
+ tarball = chrootdir <.> "tar.gz"
+
+
+thanks
diff --git a/doc/forum/REversable_property_changes/comment_1_951cef3c45112f69254118afbc6fa76e._comment b/doc/forum/REversable_property_changes/comment_1_951cef3c45112f69254118afbc6fa76e._comment
new file mode 100644
index 00000000..cf574fbf
--- /dev/null
+++ b/doc/forum/REversable_property_changes/comment_1_951cef3c45112f69254118afbc6fa76e._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-11-11T19:16:35Z"
+ content="""
+Combining a Property HasInfo with a RevertableProperty HasInfo should work
+fine, and I have not been able to reproduce this type error with some
+simple combinations of such properties.
+
+Can you share the code that produces the type error?
+"""]]
diff --git a/doc/forum/REversable_property_changes/comment_2_bf2e563f302268765733dde0d4f901fc._comment b/doc/forum/REversable_property_changes/comment_2_bf2e563f302268765733dde0d4f901fc._comment
new file mode 100644
index 00000000..fe032c76
--- /dev/null
+++ b/doc/forum/REversable_property_changes/comment_2_bf2e563f302268765733dde0d4f901fc._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2015-11-11T19:55:04Z"
+ content="""
+It seems that this is the combinaison of a Revertable HasInfo with a Property NoInfo
+
+I will sen you the file
+"""]]
diff --git a/doc/forum/REversable_property_changes/comment_3_b6e6a50654fcac2f624c43a04e12c4d6._comment b/doc/forum/REversable_property_changes/comment_3_b6e6a50654fcac2f624c43a04e12c4d6._comment
new file mode 100644
index 00000000..ed7fdfca
--- /dev/null
+++ b/doc/forum/REversable_property_changes/comment_3_b6e6a50654fcac2f624c43a04e12c4d6._comment
@@ -0,0 +1,24 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-11-12T16:05:44Z"
+ content="""
+Ok, what's going on is that the combination of a RevertableProperty and a
+Property with requires has changed from being a RevertableProperty before
+to a Property now. (Because it can't all be reverted.)
+
+Since your code has `schroot :: RevertableProperty HasInfo`
+ghc complains that the type it infers doesn't match. Changing that to
+`Property HasInfo` will clear up the type error.
+
+Unfortunate that the error message is complicated in this case by the
+use of CInfo and CombinedType. If you notice that
+`CInfo HasInfo NoInfo = HasInfo` and that `CombinedType (RevertableProperty
+HasInfo) (Property NoInfo) = Property HasInfo`, a better error message
+would be:
+
+ Couldn't match type ‘Property HasInfo'
+ with ‘RevertableProperty HasInfo’
+ Expected type: RevertableProperty HasInfo
+ Actual type: Property HasInfo
+"""]]
diff --git a/doc/forum/REversable_property_changes/comment_4_80ebeaedce18dea401c0e754309b5c7b._comment b/doc/forum/REversable_property_changes/comment_4_80ebeaedce18dea401c0e754309b5c7b._comment
new file mode 100644
index 00000000..d4b47355
--- /dev/null
+++ b/doc/forum/REversable_property_changes/comment_4_80ebeaedce18dea401c0e754309b5c7b._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 4"
+ date="2015-11-12T19:35:45Z"
+ content="""
+ok, But I rellay want a Revertable Property.
+
+should I just make a revertable property of the installed Property in order to have
+
+RevertableProperty HasInfo `required` (installed <!> doNothing)
+"""]]
diff --git a/doc/forum/REversable_property_changes/comment_5_4b876eae2404ea107ba65a3c879a4c2a._comment b/doc/forum/REversable_property_changes/comment_5_4b876eae2404ea107ba65a3c879a4c2a._comment
new file mode 100644
index 00000000..7fe0e9fe
--- /dev/null
+++ b/doc/forum/REversable_property_changes/comment_5_4b876eae2404ea107ba65a3c879a4c2a._comment
@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2015-11-13T04:25:47Z"
+ content="""
+It depends. If it makes sense for your property to remove the software
+when it's reverted, then make `installed` revertable like that.
+
+Maybe that doesn't make sense though, you only want to make sure it's
+installed before using it, but you don't necessarily want to remove it just
+because this one property that uses it gets reverted. You can express that
+this way:
+
+ ((setup `requires` installed) <!> cleanup)
+
+I do think it was a good change, in propellor 2.13.0, to make "revertable
+`requires` nonrevertable" not be a RevertableProperty. Now when we want a
+RevertableProperty, we have to think about whether it makes sense to revert
+the whole thing or not; before this change we just got back a so-called
+RevertableProperty that was not actually fully revertable, and probably
+didn't think about it enough.
+"""]]
diff --git a/doc/forum/Script_to_convert_config_files_for_inclusion_in_Propellor_config.mdwn b/doc/forum/Script_to_convert_config_files_for_inclusion_in_Propellor_config.mdwn
new file mode 100644
index 00000000..c9f5ec8b
--- /dev/null
+++ b/doc/forum/Script_to_convert_config_files_for_inclusion_in_Propellor_config.mdwn
@@ -0,0 +1,41 @@
+This script turns
+
+ Section "Monitor"
+ Identifier "Configured Monitor"
+ EndSection
+
+into this:
+
+ [ "Section \"Monitor\""
+ , "\tIdentifier \"Configured Monitor\""
+ , "EndSection"
+ ]
+
+for the inclusion of short config files in your Propellor config using `File.hasContent`.
+
+[[!format haskell """
+#!/usr/bin/runhaskell
+
+main = interact $ unlines . propellorLines . lines
+
+propellorLines :: [String] -> [String]
+propellorLines (x:xs) = ("[ " ++ wrapEscapeLine x) : propellorLines' xs
+
+propellorLines' :: [String] -> [String]
+propellorLines' = foldr step ["]"]
+ where
+ step x xs = (", " ++ wrapEscapeLine x) : xs
+
+wrapEscapeLine :: String -> String
+wrapEscapeLine line = "\"" ++ (foldr step "" line) ++ "\""
+ where
+ step x xs
+ | x == '\t' = "\\t" ++ xs
+ | x == '\\' = x : x : xs
+ | x == '"' = '\\' : x : xs
+ | otherwise = x : xs
+"""]]
+
+Usage: `cat config_file | propellor_lines` (or in Emacs, dump the config file into your propellor config, select the region and use `C-u M-|` to pipe it through).
+
+-- [[spwhitton|https://spwhitton.name]]
diff --git a/doc/forum/Script_to_convert_config_files_for_inclusion_in_Propellor_config/comment_1_98a4c56ba162a1e04a5b5649ff39ee3f._comment b/doc/forum/Script_to_convert_config_files_for_inclusion_in_Propellor_config/comment_1_98a4c56ba162a1e04a5b5649ff39ee3f._comment
new file mode 100644
index 00000000..553ba0b9
--- /dev/null
+++ b/doc/forum/Script_to_convert_config_files_for_inclusion_in_Propellor_config/comment_1_98a4c56ba162a1e04a5b5649ff39ee3f._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="Quasiquoter"
+ date="2016-02-22T04:25:24Z"
+ content="""
+You could also use something like [raw-strings-qq](http://hackage.haskell.org/package/raw-strings-qq) to embed the files as-is without having to quote/escape a ton of stuff.
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed..mdwn b/doc/forum/Shared_connection_to_xxx_closed..mdwn
new file mode 100644
index 00000000..ddcbd90c
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed..mdwn
@@ -0,0 +1,58 @@
+Hello,
+
+yesterday I was affected by a power outrage will deploying a machine with propellor.
+Once restarted, I discovered that my git repository containing the propello (aka. ~/.propellor) was corrupted some objects were empty).
+So I decided to make a clean clone of my central propellor repository.
+
+what I did exactly, is
+mv ~/.propello ~/.propellor.orig
+mkdir ~/.propellor
+cd ~/.propellor && git init
+cp ~/.propellor.orig/.git/config ~/.propellor/.git/
+
+then I did
+
+git pull --all
+
+but now when I run propellor, I get this error message.
+
+:~$ propellor
+** warning: ** Your /home/picca/.propellor is out of date..
+ A newer upstream version is available in /usr/src/propellor/propellor.git
+ To merge it, run: git merge upstream/master
+
+Building propellor-2.7.3...
+Preprocessing library propellor-2.7.3...
+In-place registering propellor-2.7.3...
+Preprocessing executable 'propellor' for propellor-2.7.3...
+Preprocessing executable 'propellor-config' for propellor-2.7.3...
+Propellor build ... done
+
+
+Pull from central git repository ... done
+git branch origin/master gpg signature verified; merging
+Already up-to-date.
+Building propellor-2.7.3...
+Preprocessing library propellor-2.7.3...
+In-place registering propellor-2.7.3...
+Preprocessing executable 'propellor' for propellor-2.7.3...
+Preprocessing executable 'propellor-config' for propellor-2.7.3...
+Propellor build ... done
+
+Une phrase secrète est nécessaire pour déverrouiller la clef secrète de
+l'utilisateur : « Picca Frédéric-Emmanuel <picca@debian.org> »
+clef RSA de 4096 bits, identifiant 4696E015, créée le 2011-02-14
+
+[master dc8fbd3] propellor spin
+Git commit ... done
+Décompte des objets: 1, fait.
+Écriture des objets: 100% (1/1), 862 bytes | 0 bytes/s, fait.
+Total 1 (delta 0), reused 0 (delta 0)
+To git+ssh://xxxxxxxx/propellor
+ 8b1647f..dc8fbd3 master -> master
+Push to central git repository ... done
+Shared connection to xxxxx closed.
+
+I would like to know if you think this could be problem in propellor (I do not know all the magic involved in the deployment process of propellor).
+
+thanks
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_1_b0db2468e86d29deac6167363f88cfdc._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_1_b0db2468e86d29deac6167363f88cfdc._comment
new file mode 100644
index 00000000..da332234
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_1_b0db2468e86d29deac6167363f88cfdc._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-09-15T15:38:13Z"
+ content="""
+Propellor uses a shared ssh connection to the remote host to avoid
+the overhead of multiple ssh connections. ssh will sometimes say "shared
+connection ... closed" when taking down such a connection.
+
+Propellor only reuses such a shared connection for up to 10 minutes; it it
+finds an old one (perhaps from a previous run of propellor), it will ask
+ssh to close the old connection.
+
+I don't think it's anything to worry about unless propellor is failing to
+work for some reason.
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_2_fa080c190da730dfd023e96ca4000b93._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_2_fa080c190da730dfd023e96ca4000b93._comment
new file mode 100644
index 00000000..57ebef84
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_2_fa080c190da730dfd023e96ca4000b93._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2015-09-15T15:51:15Z"
+ content="""
+Ok I understand but in my case, the connection was closed when propellor should have connect as root to the host and execute the spin action.
+
+So it only push to the central repository (ok) but did not proceed to the host installation.
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_3_1beb3b93a20111af8f736a7581b46d6c._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_3_1beb3b93a20111af8f736a7581b46d6c._comment
new file mode 100644
index 00000000..3c2e407d
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_3_1beb3b93a20111af8f736a7581b46d6c._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-09-15T17:19:54Z"
+ content="""
+Well, I'd expect propellor would exit nonzero if it fails to connect to the
+host to spin it. Did this not happen?
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_4_bc60f392f8a73ac7bc54f5c3a4670590._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_4_bc60f392f8a73ac7bc54f5c3a4670590._comment
new file mode 100644
index 00000000..41ad0fc3
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_4_bc60f392f8a73ac7bc54f5c3a4670590._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 4"
+ date="2015-09-17T06:59:44Z"
+ content="""
+[2015-09-17 08:57:49 CEST] call: ssh [\"-o\",\"ControlPath=/home/picca/.ssh/propellor/xxxx.sock\",\"-o\",\"ControlMaster=auto\",\"-o\",\"ControlPersist=yes\",\"-t\",\"root@xxx\",\"sh -c 'cd /usr/local/propellor && ./propellor --continue '\\"'\\"'SimpleRun \\"xxx\\"'\\"'\\"''\"]
+Shared connection to xxxxx closed.
+picca@ORD03037:~/.propellor$ echo $?
+0
+
+
+so it seems thaht there is no error but the share connection was closed before running propellor on the host.
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_5_7be9e5912ef4165bf193f65f51b8216b._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_5_7be9e5912ef4165bf193f65f51b8216b._comment
new file mode 100644
index 00000000..15c06336
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_5_7be9e5912ef4165bf193f65f51b8216b._comment
@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2015-09-21T19:47:17Z"
+ content="""
+So here's the code that runs that ssh command:
+
+ unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
+ error "remote propellor failed"
+
+I'm surprised it didn't fail with the error. This seems to say that ssh
+exited 0, but without running the command.
+
+Also, ssh seems to have decided to take down the shared connection of its
+own accord, which seems strange. Normally it should leave the shared
+connection open.
+
+If you're able to reproduce this reliably, look into whether making
+`sshCachingParams` return [] and thus get rid of this ssh connection caching somehow avoids the problem?
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_6_2798a6806afd2d04cf6c7744ad633133._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_6_2798a6806afd2d04cf6c7744ad633133._comment
new file mode 100644
index 00000000..e07a58f9
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_6_2798a6806afd2d04cf6c7744ad633133._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 6"
+ date="2015-09-23T11:44:21Z"
+ content="""
+I did the test without the cache system and it was not better (same error message).
+Then I removed /usr/local/propellor and run propellor from scratch-> it worked :)
+
+So now I have a working propellor directory and a non working one.
+I checked that putting back the old /usr/local/propellor cause the same trouble.
+
+If you want I can send you in private both version of the directory.
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_7_dbf3e1aab2a21b796992d959a82b9fc2._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_7_dbf3e1aab2a21b796992d959a82b9fc2._comment
new file mode 100644
index 00000000..eb951ca6
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_7_dbf3e1aab2a21b796992d959a82b9fc2._comment
@@ -0,0 +1,19 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2015-09-23T16:52:12Z"
+ content="""
+Ah, that makes much more sense; rather than a strange ssh problem,
+propellor is apparently exiting 0 w/o doing anything when run
+with `./propellor --continue 'SimpleRun "xxx"'` or something close to that.
+
+So, this might have to do with the old propellor not supporting SimpleRun,
+which was added back in 0.4.0.
+
+Or, more likely, it's broken in some way that makes it not do anything when
+asked to so a SimpleRun for a particular host.
+
+You can probably try running the old propellor with that SimpleRun parameter and
+the command line and get a better feel for what it's doing, and if desired,
+bisect or otherwise instrument the program to see why it behaved this way.
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_8_cf2215bc51ed57558c76beb5226cf5fa._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_8_cf2215bc51ed57558c76beb5226cf5fa._comment
new file mode 100644
index 00000000..948ccba9
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_8_cf2215bc51ed57558c76beb5226cf5fa._comment
@@ -0,0 +1,26 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 8"
+ date="2015-09-24T08:41:50Z"
+ content="""
+Good
+root@xxxx:/usr/local/propellor.good/dist/build/propellor-config# ls -l
+-rwxr-xr-x 1 root root 6359256 sept. 23 09:34 propellor-config
+drwxr-xr-x 4 root root 4096 sept. 23 09:34 propellor-config-tmp
+
+Bad
+root@xxxx:/usr/local/propellor.bad/dist/build/propellor-config# ls -l
+total 4
+-rwxr-xr-x 1 root root 0 sept. 14 14:05 propellor-config
+drwxr-xr-x 4 root root 4096 sept. 14 14:05 propellor-config-tmp
+
+ok so it seems that propellor-config is empty ??? for the bad version.
+
+Now I understand better why nothing happened :)
+So maybe the power outrage was done during the compilation of the propellor-config executable.
+Maybe something can be done in order to avoid producing this empty file.
+Maybe just keep the old version of propellor-config until the new propellor-config is ready to replace it.
+
+
+
+"""]]
diff --git a/doc/forum/Shared_connection_to_xxx_closed./comment_9_3f3028244efa8a6528a4530bca4cb222._comment b/doc/forum/Shared_connection_to_xxx_closed./comment_9_3f3028244efa8a6528a4530bca4cb222._comment
new file mode 100644
index 00000000..e5378cc7
--- /dev/null
+++ b/doc/forum/Shared_connection_to_xxx_closed./comment_9_3f3028244efa8a6528a4530bca4cb222._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-09-25T13:31:47Z"
+ content="""
+Ah, I remember seeing this once myself. ghc and cabal don't get the binary
+updated atomically.
+
+I've got a fix on the joeyconfig branch, it makes sure the binary is built
+and then atomically updates a copy that's used to run propellor.
+"""]]
diff --git a/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user.mdwn b/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user.mdwn
new file mode 100644
index 00000000..aa40dffc
--- /dev/null
+++ b/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user.mdwn
@@ -0,0 +1 @@
+I couldn't quite figure out what is wrong with the code as written, but the properties in modAuthorizedKey relating to the file modes/ownership get applied before the properties to create the directory and file are applied, so if they don't already exist then you get an error.
diff --git a/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user/comment_1_e22d4f2c96564a7f927a83207651be1c._comment b/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user/comment_1_e22d4f2c96564a7f927a83207651be1c._comment
new file mode 100644
index 00000000..40ab94c4
--- /dev/null
+++ b/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user/comment_1_e22d4f2c96564a7f927a83207651be1c._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-02-26T14:55:32Z"
+ content="""
+Indeed, I think I've fixed it by making the permissions fixup come `after`
+the property that creates the file, rather than `before`.
+"""]]
diff --git a/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user/comment_2_3cd8b6d02f8826f27b41c1ca27817bfe._comment b/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user/comment_2_3cd8b6d02f8826f27b41c1ca27817bfe._comment
new file mode 100644
index 00000000..5b308812
--- /dev/null
+++ b/doc/forum/Ssh.authorizedKey_does_not_work_on_brand_new_user/comment_2_3cd8b6d02f8826f27b41c1ca27817bfe._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 2"
+ date="2016-02-26T23:36:33Z"
+ content="""
+I just verified that it works now (with your fix), thanks!
+"""]]
diff --git a/doc/forum/Supported_OS.mdwn b/doc/forum/Supported_OS.mdwn
new file mode 100644
index 00000000..f17b9054
--- /dev/null
+++ b/doc/forum/Supported_OS.mdwn
@@ -0,0 +1,5 @@
+What are the requirements for the configured OS ? Does it need to be Debian ?
+
+Would Propellor work for Arch linux, RHEL, Windows, AIX or linux on pSeries) ?
+
+Cheers
diff --git a/doc/forum/Supported_OS/comment_1_f324bed708305e2667bd00f80544dd90._comment b/doc/forum/Supported_OS/comment_1_f324bed708305e2667bd00f80544dd90._comment
new file mode 100644
index 00000000..7649e95e
--- /dev/null
+++ b/doc/forum/Supported_OS/comment_1_f324bed708305e2667bd00f80544dd90._comment
@@ -0,0 +1,23 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2014-12-07T15:58:03Z"
+ content="""
+I have heard of propellor being used on OSX. Probably that user wrote their
+own code for OSX specific stuff.
+
+Propellor properites can be parameterized by OS. Currently it has support
+for Debian and some untested support for *buntu. A property can be parameterized
+like this:
+
+ foo :: Property
+ foo = property "foo" withOS desc $ \o -> case o of
+ (Just (System (Debian _) _)) -> ensureProperty fooDebian
+ (Just (System (Buntish _) _)) -> ensureProperty fooBuntu
+
+The first step for adding a new OS will be to modify <http://hackage.haskell.org/package/propellor/docs/Propellor-Types-OS.html>.
+Compilation will then warn about all OS parameterized properties that
+need to be updated to support your added OS, and it can be taken from there.
+
+I'll accept reasonable patches to support other OS's.
+"""]]
diff --git a/doc/forum/Supported_OS/comment_2_4fcaadea6d57e4bf127fd28720e3ba20._comment b/doc/forum/Supported_OS/comment_2_4fcaadea6d57e4bf127fd28720e3ba20._comment
new file mode 100644
index 00000000..07c12d0b
--- /dev/null
+++ b/doc/forum/Supported_OS/comment_2_4fcaadea6d57e4bf127fd28720e3ba20._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-03-08T01:48:35Z"
+ content="""
+Propellor just got support for [[FreeBSD]]!
+"""]]
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container.mdwn b/doc/forum/Systemd.container_produces_non-standard_systemd_container.mdwn
new file mode 100644
index 00000000..fb523a1c
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container.mdwn
@@ -0,0 +1,31 @@
+I just tried Systemd.container. The process seemed to work well, and I can log to the container with
+
+ $ machinectl --shell root@mycontainer
+
+but machinectl can't clone the image
+
+ $ machinectl clone mycontainer testclone
+ Could not clone image: Operation not supported
+
+I can export and import the image:
+
+ $ machinectl export-tar mycontainer /var/tmp/testclone.tar.gz
+ $ machinectl import-tar /var/tmp/testclone.tar.gz test-container
+
+list-images gives does not give the same information for both images:
+
+ $ machinectl list-images
+ NAME TYPE RO USAGE CREATED MODIFIED
+ mycontainer directory no n/a n/a n/a
+ testclone subvolume no 60M Thu 2015-09-24 22:41:39 CEST n/a
+
+but I can clone my newly imported image:
+
+ $ machinectl clone testclone testclone2
+ $ machinectl list-images
+ NAME TYPE RO USAGE CREATED MODIFIED
+ mycontainer directory no n/a n/a n/a
+ testclone subvolume no 60M Thu 2015-09-24 22:41:39 CEST n/a
+ testclone2 subvolume no 60M Thu 2015-09-24 22:48:39 CEST n/a
+
+I guess "machinectl clone" does a little more than just copying the images...
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_1_07ddf79f04240fd7c9911199b5e7ffd4._comment b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_1_07ddf79f04240fd7c9911199b5e7ffd4._comment
new file mode 100644
index 00000000..f80a6dc9
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_1_07ddf79f04240fd7c9911199b5e7ffd4._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 1"
+ date="2015-09-25T14:39:49Z"
+ content="""
+I forgot to tell that /var is a btrfs partition...
+"""]]
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_2_1f3607a766f4a6bd7a297d958a7f1087._comment b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_2_1f3607a766f4a6bd7a297d958a7f1087._comment
new file mode 100644
index 00000000..dd918e72
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_2_1f3607a766f4a6bd7a297d958a7f1087._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-09-26T12:33:57Z"
+ content="""
+The FilePath parameter to Chroot.debootstrapped is the directory to put the
+chroot in.
+
+If you have a property foo that takes such a chroot directory and generates
+the tarball you need, you can compose it thus:
+
+ Chroot.debootstrapped system chrootdir
+ `onChange` foo chrootdir tarball
+"""]]
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_3_04262501adfdb4a2448618f91024f5c0._comment b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_3_04262501adfdb4a2448618f91024f5c0._comment
new file mode 100644
index 00000000..c32fee70
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_3_04262501adfdb4a2448618f91024f5c0._comment
@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="https://mathstuf.id.fedoraproject.org/"
+ nickname="mathstuf"
+ subject="comment 3"
+ date="2015-10-20T01:01:54Z"
+ content="""
+You can see the difference here:
+
+```
+mycontainer directory no n/a n/a n/a
+testclone subvolume no 60M Thu 2015-09-24 22:41:39 CEST n/a
+```
+
+Your container is a directory while the clone is a subvolume (of btrfs). Cloning the machine involves doing some btrfs magic I would assume (with no `cp -a` backup). The error message could be more descriptive…
+"""]]
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_4_5dc1c3ee7f111fcc36c72487b7713854._comment b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_4_5dc1c3ee7f111fcc36c72487b7713854._comment
new file mode 100644
index 00000000..d7fe1dd5
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_4_5dc1c3ee7f111fcc36c72487b7713854._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="jerryjacobs1989@d19093c366dfb2959c549ed1aff6175ddc7a7a5b"
+ nickname="jerryjacobs1989"
+ subject="Thank you"
+ date="2015-11-29T13:04:56Z"
+ content="""
+I was bitten also by this weird error message and have submitted it upstream:
+https://github.com/systemd/systemd/issues/2060
+"""]]
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_5_b73901c0aa408d35346c46e523be8c3f._comment b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_5_b73901c0aa408d35346c46e523be8c3f._comment
new file mode 100644
index 00000000..61f34253
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_5_b73901c0aa408d35346c46e523be8c3f._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 5"
+ date="2016-03-28T19:39:22Z"
+ content="""
+The error message is one thing, but shouldn't the container built with Systemd.container be clonable? Maybe by adding an additional \"export-tar/import-tar\" step to Systemd.container or by using something different from mkchroot?
+"""]]
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_6_3394c1a7a485057fda84dd910e29d90f._comment b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_6_3394c1a7a485057fda84dd910e29d90f._comment
new file mode 100644
index 00000000..9ae8219c
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_6_3394c1a7a485057fda84dd910e29d90f._comment
@@ -0,0 +1,23 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2016-03-29T21:09:25Z"
+ content="""
+ clone NAME NAME
+ Clones a container or VM image. The arguments specify the
+ name of the image to clone and the name of the newly
+ cloned image. Note that plain directory container images
+ are cloned into subvolume images with this command.
+
+That seems to say that the directory that Systemd.container sets up
+should be clonable too. Perhaps this is a systemd bug?
+
+If systemd needs a container to be loaded from a tarball in order to be
+clonable this way, I guess I would not mind if Systemd.container did that
+as part of its initial bootstrapping. But it is extra work so I'd like to
+make sure that it's really intended to need to do that.
+
+(Myself, I don't care if I can't clone a container; I can delete any of them
+and propellor can rebuild them, or even move the line to a different host
+in config.hs to relocate the container.)
+"""]]
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_7_5a3418e8cc800ceea5988059b6d86aff._comment b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_7_5a3418e8cc800ceea5988059b6d86aff._comment
new file mode 100644
index 00000000..e6e24c42
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_7_5a3418e8cc800ceea5988059b6d86aff._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 7"
+ date="2016-03-30T11:32:51Z"
+ content="""
+After a chat session on #systemd, I've posted a new issue https://github.com/systemd/systemd/issues/2914
+There should be updates soon.
+"""]]
diff --git a/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_8_f0968beaac7e73e192c0d59fe0637c0e._comment b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_8_f0968beaac7e73e192c0d59fe0637c0e._comment
new file mode 100644
index 00000000..ac192232
--- /dev/null
+++ b/doc/forum/Systemd.container_produces_non-standard_systemd_container/comment_8_f0968beaac7e73e192c0d59fe0637c0e._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 8"
+ date="2016-05-24T13:19:44Z"
+ content="""
+https://github.com/systemd/systemd/issues/2914 is fixed in systemd 230
+"""]]
diff --git a/doc/forum/Understanding_changesFile_equation.mdwn b/doc/forum/Understanding_changesFile_equation.mdwn
new file mode 100644
index 00000000..5e360097
--- /dev/null
+++ b/doc/forum/Understanding_changesFile_equation.mdwn
@@ -0,0 +1,15 @@
+Hi, I'm trying to understand a part of the `changesFile` equation, specifically `oldstat`.
+
+```
+changesFile :: Checkable p i => p i -> FilePath -> Property i
+changesFile p f = checkResult getstat comparestat p
+ where
+ getstat = catchMaybeIO $ getSymbolicLinkStatus f
+ comparestat oldstat = do
+ newstat <- getstat
+ return $ if samestat oldstat newstat then NoChange else MadeChange
+```
+
+As we see, we catch `getstat` given `f`, but what I don't understand or see, is how is `oldstat` been passed/generated?
+
+Thanks for the help.
diff --git a/doc/forum/Understanding_changesFile_equation/comment_1_eab28824f8cd1a03bcc16aee4e161643._comment b/doc/forum/Understanding_changesFile_equation/comment_1_eab28824f8cd1a03bcc16aee4e161643._comment
new file mode 100644
index 00000000..22bcc014
--- /dev/null
+++ b/doc/forum/Understanding_changesFile_equation/comment_1_eab28824f8cd1a03bcc16aee4e161643._comment
@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-02-24T21:09:52Z"
+ content="""
+`checkResult` is the key to understanding this. Its (simplified) type
+signature:
+
+ checkResult :: m a -> (a -> m Result) -> p i -> Property i
+
+It's being given getstat as the first parameter. It runs that before the
+property does anything, and it passes that value to comparestat.
+
+So, oldstat is the getstat value from before the property did anything.
+"""]]
diff --git a/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning.mdwn b/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning.mdwn
new file mode 100644
index 00000000..f1bb6e1c
--- /dev/null
+++ b/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning.mdwn
@@ -0,0 +1 @@
+I'm managing a host with propellor that is booted up perhaps once per week at random times (it's my grandparents' machine). I have it running propellor with a cronjob in the standard way, pulling from a git repository, so I can update its configuration by pushing PGP-signed changes to the centralised git repo. Now, I would like to change the URI of the centralised git remote. Can I just write a `cmdProperty` that sets the new URI on the repo in `/usr/local/propellor`? As described, I can't simply --spin the host as I never know when it's online.
diff --git a/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning/comment_1_12cf8bce9f61c98bd35c934806372ada._comment b/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning/comment_1_12cf8bce9f61c98bd35c934806372ada._comment
new file mode 100644
index 00000000..d9b21dd0
--- /dev/null
+++ b/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning/comment_1_12cf8bce9f61c98bd35c934806372ada._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-11-11T19:09:43Z"
+ content="""
+Makes sense, and should work. I've exposed propellor's existing code to do
+that as Propellor.Property.PropellorRepo.hasOriginUrl
+"""]]
diff --git a/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning/comment_2_dd35e93f3b9e0d2e1041674eee1e6fc8._comment b/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning/comment_2_dd35e93f3b9e0d2e1041674eee1e6fc8._comment
new file mode 100644
index 00000000..8d35d721
--- /dev/null
+++ b/doc/forum/Updating_a_host__39__s_centralised_git_repo_URI_without_spinning/comment_2_dd35e93f3b9e0d2e1041674eee1e6fc8._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 2"
+ date="2015-11-14T23:33:58Z"
+ content="""
+Works -- thanks!
+"""]]
diff --git a/doc/forum/Weird_SSH_issue.mdwn b/doc/forum/Weird_SSH_issue.mdwn
new file mode 100644
index 00000000..11094d55
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue.mdwn
@@ -0,0 +1,3 @@
+For some reason (and I'm not sure exactly when this started), when I propellor --spin a host when the control master socket does not yet exist, none of the output from the remote host comes back. The remote run works fine, I just have to ^C the local propellor once I see that the remote run is done (by watching top on the remote host or something). If the socket does already exist (eg. spinning again immediately), then everything is fine.
+
+I assume this is some issue with my local SSH version or config, but I have no clue what. Anyone have any ideas?
diff --git a/doc/forum/Weird_SSH_issue/comment_1_8598e38bc60fd25ebecb7b3b09d74940._comment b/doc/forum/Weird_SSH_issue/comment_1_8598e38bc60fd25ebecb7b3b09d74940._comment
new file mode 100644
index 00000000..0eb98f6c
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_1_8598e38bc60fd25ebecb7b3b09d74940._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-03-06T17:00:02Z"
+ content="""
+I think I've been seeing this too, recently.
+
+I had not put together that it involves the ssh control socket.
+And am not 100% sure it does yet.
+"""]]
diff --git a/doc/forum/Weird_SSH_issue/comment_2_5c0bb1b38a92ff17277f514703ce2761._comment b/doc/forum/Weird_SSH_issue/comment_2_5c0bb1b38a92ff17277f514703ce2761._comment
new file mode 100644
index 00000000..0b545262
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_2_5c0bb1b38a92ff17277f514703ce2761._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 2"
+ date="2016-03-06T17:39:34Z"
+ content="""
+Yes, it's possible I misdiagnosed the problem; I've never had the issue spinning twice in a row, but there may be other factors at play.
+"""]]
diff --git a/doc/forum/Weird_SSH_issue/comment_3_8347b69df64b737f4e5df854c55d4e92._comment b/doc/forum/Weird_SSH_issue/comment_3_8347b69df64b737f4e5df854c55d4e92._comment
new file mode 100644
index 00000000..adc64e5d
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_3_8347b69df64b737f4e5df854c55d4e92._comment
@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-03-06T17:54:20Z"
+ content="""
+It also seemed to affect the first spin and not the second one when I was
+seeing it. But that was 1-2 weeks ago, and I am not currently reproducing
+the issue.
+
+If you can reproduce it consistently, it would be good to check if the
+concurrent output layer, which involves intercepting all command output and
+serializing it, might be involved. If you edit
+`src/Utility/Process/Shim.hs` and make it simply `import System.Process as X`
+and remove the other import, that will bypass the concurrent output layer.
+"""]]
diff --git a/doc/forum/Weird_SSH_issue/comment_4_2fbb97cb5bca3a0e2835e7667aff7a00._comment b/doc/forum/Weird_SSH_issue/comment_4_2fbb97cb5bca3a0e2835e7667aff7a00._comment
new file mode 100644
index 00000000..2ffdcbac
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_4_2fbb97cb5bca3a0e2835e7667aff7a00._comment
@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-03-06T18:43:37Z"
+ content="""
+Added some debugging, I found that processes run by concurrent-output tend to
+alternate between running foreground and background. So, when the socket
+exists and is old, it will run one more process than otherwise to
+stop ssh on that socket, and this will change which run method is
+used for subsequent processes.
+
+However, it really shouldn't matter if a process starts in the background;
+concurrent-output shoud notice when the output lock frees up, and start
+displaying the processes's output.
+
+So, this theory explains why the ssh socket seems to be involved, perhaps,
+but it doesn't really explain what's happening to prevent the remote
+propellor output from being shown.
+
+Unless some other foreground process is hanging around and keeping
+the output lock. Or some bug in concurrent-output..
+"""]]
diff --git a/doc/forum/Weird_SSH_issue/comment_5_bfbcb2a81bff6b6432217c72a5e54576._comment b/doc/forum/Weird_SSH_issue/comment_5_bfbcb2a81bff6b6432217c72a5e54576._comment
new file mode 100644
index 00000000..72315aa0
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_5_bfbcb2a81bff6b6432217c72a5e54576._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2016-03-06T19:57:03Z"
+ content="""
+Managed to reproduce the hang once, and the ssh was indeed being run as
+bgProcess. However, I didn't manage to see what foreground process, if any,
+was running when that happened. And had no luck reproducing it again.
+
+I added some more `PROPELLOR_DEBUG` output around this, so it'll tell
+when a process is being run by fgProcess or bgProcess.
+"""]]
diff --git a/doc/forum/Weird_SSH_issue/comment_6_d6c4f22f48c5f0b6d06e9a155e8e5f69._comment b/doc/forum/Weird_SSH_issue/comment_6_d6c4f22f48c5f0b6d06e9a155e8e5f69._comment
new file mode 100644
index 00000000..7d01913b
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_6_d6c4f22f48c5f0b6d06e9a155e8e5f69._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 6"
+ date="2016-03-06T21:27:18Z"
+ content="""
+Might it have something to do with how ssh forks (but doesn't double fork or \"daemonize\") to start the control master, if one isn't already running?
+"""]]
diff --git a/doc/forum/Weird_SSH_issue/comment_7_77d2d330846c80ed463644860e49f184._comment b/doc/forum/Weird_SSH_issue/comment_7_77d2d330846c80ed463644860e49f184._comment
new file mode 100644
index 00000000..ab82a6c1
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_7_77d2d330846c80ed463644860e49f184._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2016-03-06T22:59:31Z"
+ content="""
+I don't see how that could be relevant, but if you want to, edit
+src/Propellor/Ssh.hs and make sshCachingParams return [] and
+see if that changes it.
+"""]]
diff --git a/doc/forum/Weird_SSH_issue/comment_8_b5ba54711a869076fdf78f81f2f5c70d._comment b/doc/forum/Weird_SSH_issue/comment_8_b5ba54711a869076fdf78f81f2f5c70d._comment
new file mode 100644
index 00000000..f5110479
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_8_b5ba54711a869076fdf78f81f2f5c70d._comment
@@ -0,0 +1,24 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 8"""
+ date="2016-03-06T23:47:58Z"
+ content="""
+I modified spin', adding this before its final ssh:
+
+ async $ createProcessForeground $ proc "sleep" ["500"]
+
+This more or less replicates the problem reliably; the remote propellor
+runs but nothing gets displayed for 500 seconds until the sleep process
+is done. At which point the whole buffered output appears. Use cat instead
+and it'll hang forever.
+
+Of course, that means `ps fax` shows propellor with sleep and ssh as
+child processes. If only ssh shows as a child process and nothing else
+when the problem naturally occurs, then that's a different problem
+than what I was able to replicate.
+
+Anyway, this seems too fragile to leave like this even though
+nothing run on the way to a ssh should run for very long.
+So, I'm making the ssh be run forced to the foreground, which will
+certianly avoid all such problems.
+"""]]
diff --git a/doc/forum/Weird_SSH_issue/comment_9_b66bfe7d8414639adc66874d7e94cabf._comment b/doc/forum/Weird_SSH_issue/comment_9_b66bfe7d8414639adc66874d7e94cabf._comment
new file mode 100644
index 00000000..f81a809f
--- /dev/null
+++ b/doc/forum/Weird_SSH_issue/comment_9_b66bfe7d8414639adc66874d7e94cabf._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 9"
+ date="2016-03-07T20:13:25Z"
+ content="""
+I didn't quite find a way to reliably reproduce the issue, but I can confirm that as expected, I haven't run into it again after merging your fix.
+"""]]
diff --git a/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__.mdwn b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__.mdwn
new file mode 100644
index 00000000..1ff79c55
--- /dev/null
+++ b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__.mdwn
@@ -0,0 +1,13 @@
+When running
+
+ propellor --spin newhost
+
+I get (after installing gnupg, ghc, libghc-*, make)
+
+ ....
+ Downloading the latest package list from hackage.haskell.org
+ Killed
+ Killed
+ Killed
+
+maybe there is not enough memory, or propellor has a kind of timeout somewhere (newhost is a slow arm router), but I don't understand why propellor (cabal) needs this package list.
diff --git a/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_1_53e13a037e2913699eb2bdd0d032a745._comment b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_1_53e13a037e2913699eb2bdd0d032a745._comment
new file mode 100644
index 00000000..22663bbb
--- /dev/null
+++ b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_1_53e13a037e2913699eb2bdd0d032a745._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 1"
+ date="2015-09-08T16:15:17Z"
+ content="""
+looking at newhost logs, I found:
+
+ Sep 8 18:02:44 newhost kernel: Out of memory: Kill process 31874 (cabal) score 824 or sacrifice child
+
+"""]]
diff --git a/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_2_a071a094c69451d6f43f3f8e01fff8a3._comment b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_2_a071a094c69451d6f43f3f8e01fff8a3._comment
new file mode 100644
index 00000000..ed97a2d8
--- /dev/null
+++ b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_2_a071a094c69451d6f43f3f8e01fff8a3._comment
@@ -0,0 +1,24 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-09-09T22:25:55Z"
+ content="""
+Propellor needs to build itself from source on the host it's
+provisioning, and so it needs to install its haskell library dependencies.
+
+It first does this by trying to apt-get install all the relevant packages.
+However, that might fail for some reason, including perhaps that new enough
+versions of some library is not available to apt-get. So, it then also
+asks cabal to install any missing dependencies. This is where the `cabal
+update` comes in. I'd rather only do that if apt didn't install all
+necessary deps, but I don't currently know how to check that, so it does it
+always.
+
+It looks like cabal may be allocating too much memory to work on your arm
+router. This could be because of a problem in depenedency resolution, which
+sometimes runs cabal out of memory even on big boxes, or it could just be
+too memory hungry to be practical there.
+
+The smallest system I've successfully run git-annex on had 500 mb of
+memory. IIRC, most memory is used when ghc is compiling propellor.
+"""]]
diff --git a/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_3_0b24a74ca08b24b6b6d14860b8ab903a._comment b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_3_0b24a74ca08b24b6b6d14860b8ab903a._comment
new file mode 100644
index 00000000..229ff1e0
--- /dev/null
+++ b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_3_0b24a74ca08b24b6b6d14860b8ab903a._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 3"
+ date="2015-09-10T09:30:57Z"
+ content="""
+The host has 128Mo of RAM :-). All dependencies should be available to apt-get, though... as it runs debian jessie. I used propellor on several other hosts running jessie also, and (it seems that) they didn't download the package list.
+
+Downloading anything from hackage is problematic because cabal uses insecure http (potential MITM), and a new version of a dependency may introduce security holes.
+
+As side note, stack may be an alternative to cabal in the case where apt can't find all the dependencies: it downloads everything securely, and stackage allows to deal with dependencies issues: the build may probably fail if new incompatible versions of propellor dependencies are released to hackage. Or maybe using strict versioning would be a solution there. Or maybe building propellor (at least for host with the same architecture) before sending it to the host?
+"""]]
diff --git a/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_4_b48193efd8c3b3d8d5992e7de0319773._comment b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_4_b48193efd8c3b3d8d5992e7de0319773._comment
new file mode 100644
index 00000000..a6b6c306
--- /dev/null
+++ b/doc/forum/Why_downloading_package_list_from_hackage.haskell.org__63__/comment_4_b48193efd8c3b3d8d5992e7de0319773._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2015-09-25T13:35:47Z"
+ content="""
+Cabal is going to download securely soon enough. There's already a branch
+of cabal that can do it.
+"""]]
diff --git a/doc/forum/can_not_build_debian_package.mdwn b/doc/forum/can_not_build_debian_package.mdwn
new file mode 100644
index 00000000..d721f922
--- /dev/null
+++ b/doc/forum/can_not_build_debian_package.mdwn
@@ -0,0 +1,25 @@
+Hello, I am trying to build the propellor package using sbuild
+
+but I got this error message during the build.
+
+Source tarball created: dist/propellor-2.5.0.tar.gz
+cat dist/propellor-*.tar.gz | (cd dist/gittmp && tar zx --strip-components=1)
+# cabal sdist does not preserve symlinks, so copy over file
+cd dist/gittmp && for f in $(find -type f); do rm -f $f; cp -a ../../$f $f; done
+cd dist/gittmp && git init && \
+ git add . \
+ && git commit -q -m "distributed version of propellor" \
+ && git bundle create /«PKGBUILDDIR»/debian/propellor/usr/src/propellor/propellor.git master HEAD \
+ && git show-ref master --hash > /«PKGBUILDDIR»/debian/propellor/usr/src/propellor/head
+Initialized empty Git repository in /«PKGBUILDDIR»/dist/gittmp/.git/
+*** Please tell me who you are.
+Run
+ git config --global user.email "you@example.com"
+ git config --global user.name "Your Name"
+
+to set your account's default identity.
+Omit --global to set the identity only in this repository.
+
+fatal: unable to auto-detect email address (got 'root@mordor.(none)')
+make[1]: *** [install] Error 128
+Makefile:13: recipe for target 'install' failed
diff --git a/doc/forum/can_not_build_debian_package/comment_1_8e4c2850f0494b761803c87cafe5b249._comment b/doc/forum/can_not_build_debian_package/comment_1_8e4c2850f0494b761803c87cafe5b249._comment
new file mode 100644
index 00000000..5e311820
--- /dev/null
+++ b/doc/forum/can_not_build_debian_package/comment_1_8e4c2850f0494b761803c87cafe5b249._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-07-11T02:35:53Z"
+ content="""
+Fixed this to set all the environment variables to make git work.
+
+(Such a pity git is so non-robust about making commits..)
+"""]]
diff --git a/doc/forum/chroot_for_sbuild.mdwn b/doc/forum/chroot_for_sbuild.mdwn
new file mode 100644
index 00000000..e2be2a36
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild.mdwn
@@ -0,0 +1,14 @@
+Hello, sorry to bother you once again :)
+
+I would like to use propellor in order to prepare a bunch of schroot for sbuild.
+This way all my machines could be used to prepare packages.
+
+so I tryed to created a Debootstrap property in order to generate the initial image
+
+ & Chroot.debootstrapped (System (Debian (Stable "jessie")) "i386") Debootstrap.BuilddD "/var/lib/sbuild/jessie-i386.tar.gz"
+
+But this does not work.
+
+So I would like to know what should be done in order to instanciante a sbuild schroot and also how to customize it in order to add the apt proxy informations.
+
+
diff --git a/doc/forum/chroot_for_sbuild/comment_10_1eb7755df6ca4324f49908c1d1984c6b._comment b/doc/forum/chroot_for_sbuild/comment_10_1eb7755df6ca4324f49908c1d1984c6b._comment
new file mode 100644
index 00000000..00920707
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_10_1eb7755df6ca4324f49908c1d1984c6b._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 10"""
+ date="2015-10-02T16:45:44Z"
+ content="""
+Seems like you could have a parameter giving the name of the schroot,
+and use that as the basis for both the location of the chroot, and the
+schroot config file.
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_1_7612dc49e14e896be8693be87200c7d3._comment b/doc/forum/chroot_for_sbuild/comment_1_7612dc49e14e896be8693be87200c7d3._comment
new file mode 100644
index 00000000..6604fab4
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_1_7612dc49e14e896be8693be87200c7d3._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 1"
+ date="2015-09-29T12:35:27Z"
+ content="""
+ok, so I created this property but it does not work
+
+ sbuild :: System -> FilePath -> Property NoInfo
+ sbuild system tarball =
+ chroot `onChange` Tar.create chrootdir tarball
+ where
+ chroot = Chroot.debootstrapped system Debootstrap.BuilddD chrootdir
+ chrootdir = \"/tmp/chroot\"
+
+it fails with this error message
+
+ src/config.hs:167:3:
+ Couldn't match expected type `Property x0'
+ with actual type `Chroot.Chroot'
+ In the first argument of `onChange', namely `chroot'
+ In the expression: chroot `onChange` Tar.create chrootdir tarball
+
+What I understand it that onChange expect a Property instead of a Chroot.
+So what is the right way to tell propellor look at this chrootdir directory and create a tarball if its containt changed.
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_2_b287ed52d9c19b6f7e4b48a5a868b703._comment b/doc/forum/chroot_for_sbuild/comment_2_b287ed52d9c19b6f7e4b48a5a868b703._comment
new file mode 100644
index 00000000..a0281702
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_2_b287ed52d9c19b6f7e4b48a5a868b703._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-09-29T14:34:07Z"
+ content="""
+So you have a Chroot and want a Property of some kind.
+If you look in the Chroot module, see this:
+
+ provisioned :: Chroot -> RevertableProperty
+
+Which is just what you're looking for.
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_3_bb01c327417848165197405f5f918caf._comment b/doc/forum/chroot_for_sbuild/comment_3_bb01c327417848165197405f5f918caf._comment
new file mode 100644
index 00000000..1ce48047
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_3_bb01c327417848165197405f5f918caf._comment
@@ -0,0 +1,34 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 3"
+ date="2015-09-30T10:05:08Z"
+ content="""
+Thanks for the information,
+
+Now I use the provision part but I am facing a problem when I try to create the chroot using withTmpDir
+I do not understand exactly how it must work
+
+here the signature of my two methods
+
+ sbuild :: System -> RevertableProperty
+ sbuild system = withTmpDir \"sbuild\" $ \tmpdir -> sbuild' system tmpdir
+
+And here the property which does the work (it works thanks to your comment, I will have other questions about this part later ;)
+
+ sbuild' :: System -> FilePath -> RevertableProperty
+ sbuild' system chrootdir = mksbuild `requires` create
+ ...
+
+When I tried this I got this error
+
+ src/config.hs:166:17:
+ Couldn't match expected type `RevertableProperty'
+ with actual type `m0 RevertableProperty'
+ In the expression:
+ withTmpDir \"sbuild\" $ \ tmpdir -> return $ sbuild' system tmpdir
+ In an equation for `sbuild':
+ sbuild system
+ = withTmpDir \"sbuild\" $ \ tmpdir -> return $ sbuild' system tmpdir
+
+I need to extract the property from the monad, but I do not know how ?
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_4_141e2f49bc9b04f7ef211394c8410cec._comment b/doc/forum/chroot_for_sbuild/comment_4_141e2f49bc9b04f7ef211394c8410cec._comment
new file mode 100644
index 00000000..5ba8eaed
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_4_141e2f49bc9b04f7ef211394c8410cec._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 4"
+ date="2015-09-30T13:06:46Z"
+ content="""
+In fact the real error meassage is this one.
+
+ src/config.hs:166:17:
+ Couldn't match expected type `RevertableProperty'
+ with actual type `m0 a0'
+ In the expression:
+ withTmpDir \"sbuild\" $ \ tmpdir -> sbuild' system tmpdir
+ In an equation for `sbuild':
+ sbuild system
+ = withTmpDir \"sbuild\" $ \ tmpdir -> sbuild' system tmpdir
+
+ src/config.hs:166:50:
+ Couldn't match expected type `m0 a0'
+ with actual type `RevertableProperty'
+ In the return type of a call of sbuild'
+ In the expression: sbuild' system tmpdir
+ In the second argument of `($)', namely
+ `\ tmpdir -> sbuild' system tmpdir'
+
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_5_dec82cad1490a22c3f2fbbaa4edbd9f0._comment b/doc/forum/chroot_for_sbuild/comment_5_dec82cad1490a22c3f2fbbaa4edbd9f0._comment
new file mode 100644
index 00000000..48fb38e6
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_5_dec82cad1490a22c3f2fbbaa4edbd9f0._comment
@@ -0,0 +1,44 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2015-09-30T14:57:26Z"
+ content="""
+You really have to follow the types here. `withTmpDir` passes a tmp dir to
+a monadic action. A RevertableProperty is not a monadic action (although it
+does contain one), so your code doesn't type check.
+
+What you can do is use `ensureProperty` to run a property from within
+the Propellor action of an enclosing property. The type of that is
+`ensureProperty :: Property NoInfo -> Propellor Result` ,
+so it can't be used on a RevertableProperty like your `sbuild'`.
+If you can get a `foo :: System -> FilePath -> Property NoInfo`, you can
+use it with `ensureProperty` like this:
+
+ sbuild system = property "some desc" $ do
+ ensureProperty $
+ withTmpDir "sbuild" $ \tmpdir -> foo system tmpdir
+
+But .. To get from a RevertableProperty to a Property NoInfo is a fraught
+conversion. `toProp` can get to a Property HasInfo. You'd have to use
+`ignoreInfo` to get from there to a Property NoInfo, and a lot of care
+should be taken when using `ignoreInfo`.
+
+It *might* be ok to ignoreInfo in this case; the agument would go that this
+is a chroot being used to create a sbuild image, so any Info belonging to
+properties of the chroot doesn't affect the host that it's built on,
+and so it doesn't need to propagate out. But, consider that this would
+break any properties inside the chroot that use privdata, since
+privdata works via info.
+
+I'd probably take an alternate tack here. Make `sbuild` use a chroot
+directory in a fixed location, instead of a temp directory. It could
+base the chroot location on the filename of the tarball it's creating
+`(++ ".chroot")`, for example.
+
+That approach also has the benefit of letting you alter properties of the
+chroot and propellor will modify the existing chroot to meet those
+properties, which is faster than building a new chroot every time.
+
+(Then you can use `onChange` to update the schroot tarball anytime the
+chroot changes.)
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_6_9a0b4cce3a9cac8504358d6a280c24bb._comment b/doc/forum/chroot_for_sbuild/comment_6_9a0b4cce3a9cac8504358d6a280c24bb._comment
new file mode 100644
index 00000000..b2196f8a
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_6_9a0b4cce3a9cac8504358d6a280c24bb._comment
@@ -0,0 +1,48 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 6"
+ date="2015-10-02T14:15:23Z"
+ content="""
+Just for information, here my solution. It is not perfect but it works :)
+thanks a lot for your help
+
+ sbuild :: System -> RevertableProperty
+ sbuild system = sbuild' chroot
+ where
+ chroot = Chroot.debootstrapped system Debootstrap.BuilddD \"/var/lib/sbuild\"
+ & \"/etc/apt/apt.conf.d/01proxy\" `File.hasContent` [\"Acquire::http::Proxy \\"http://w.x.y.z:8080\\";\"]
+ & Apt.installed [\"apt-transport-https\"]
+
+
+ sbuild' :: Chroot -> RevertableProperty
+ sbuild' chroot@(Chroot basedir system _ _) = setup <!> cleanup
+ where
+ setup = toProp (Chroot.provisioned chroot) `onChange` setup'
+
+ setup' = property (\"sbuild-creatchroot \" ++ chrootdir) $ do
+ -- unmount helper filesystems such as proc from the chroot
+ -- before getting sizes
+ liftIO $ Mount.unmountBelow chrootdir
+ -- use the chroot for sbuild
+ ensureProperty $
+ scriptProperty (rmconfig chrootdir ++
+ [ \"sbuild-createchroot --setup-only --keep-sbuild-chroot-dir --make-sbuild-tarball=\" ++ tarball ++ \" \" ++ name ++ \" \" ++ chrootdir ++ \" http://httpredir.debian.org/debian\"
+ ])
+
+ cleanup = scriptProperty (rmconfig chrootname ++ [\"rm -f -v \" ++ tarball])
+ `onChange` toProp (revert (Chroot.provisioned chroot))
+
+ (name, arch) = case system of
+ (System (Debian (Stable suite)) a) -> (suite, a)
+
+ chrootname = name ++ \"-\" ++ arch
+
+ chrootdir = basedir </> chrootname
+
+ tarball = chrootdir ++ \".tar.gz\"
+
+ rmconfig c = [ \"rm -f -v \" ++ \"/etc/schroot/chroot.d\" </> (c ++ \"-sbuild-*\")
+ , \"rm -f -v \" ++ \"/etc/sbuild/chroot\" </> (c ++ \"-sbuild\")
+ ]
+
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_7_c350c4fba2d7e1bdde6e7cc249052c22._comment b/doc/forum/chroot_for_sbuild/comment_7_c350c4fba2d7e1bdde6e7cc249052c22._comment
new file mode 100644
index 00000000..c66c2609
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_7_c350c4fba2d7e1bdde6e7cc249052c22._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2015-10-02T15:20:30Z"
+ content="""
+Factoring out a generic Propellor.Property.Sbuild would make this more
+perfect... ;)
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_8_546b34de1ed2d853fb170f944bba307d._comment b/doc/forum/chroot_for_sbuild/comment_8_546b34de1ed2d853fb170f944bba307d._comment
new file mode 100644
index 00000000..77133891
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_8_546b34de1ed2d853fb170f944bba307d._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 8"
+ date="2015-10-02T16:09:38Z"
+ content="""
+This could the plan, but I am not very confident that my code is generic enought.
+
+In this case I do not like the way I give the chroot to the sbuild method.
+In fact I do not find the interface of this command generic enought.
+
+There is assumtions in the code:
+ - the initial configuration of sbuild was done
+ - the chrootdir is hardcoded into /var/lib/sbuild and I do not know if this is the right way to do things.
+
+If you would have some advices about interface, because it seems to me thaht you are great for this :)
+
+"""]]
diff --git a/doc/forum/chroot_for_sbuild/comment_9_10dae8ccbd9a8b79e4adab2fa403a409._comment b/doc/forum/chroot_for_sbuild/comment_9_10dae8ccbd9a8b79e4adab2fa403a409._comment
new file mode 100644
index 00000000..b7a649e5
--- /dev/null
+++ b/doc/forum/chroot_for_sbuild/comment_9_10dae8ccbd9a8b79e4adab2fa403a409._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 9"
+ date="2015-10-02T16:16:41Z"
+ content="""
+Another problem is the schroot cofngiuration files.
+
+sbuild-createchroot create a configuration /stc/schroot/chroot.d/jessie-i386-sbuild-xxxx where xxxx is random.
+In this code I remove all jessie-i386-sbuild-* files, but this seems plain wrong...
+"""]]
diff --git a/doc/forum/chroot_issue_when_upgrading.mdwn b/doc/forum/chroot_issue_when_upgrading.mdwn
new file mode 100644
index 00000000..9d65eed4
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading.mdwn
@@ -0,0 +1,42 @@
+Hello,
+
+It seems that my unstable chroot is broken.
+When I do an upgrade, I get this error message
+
+
+ E: dpkg was interrupted, you must manually run 'dpkg --configure -a' to correct the problem.
+ /srv/chroot/unstable-i386-sbuild has Operating System (Debian Unstable) "i386" ... ok
+ /srv/chroot/unstable-i386-sbuild noop property ... ok
+ /srv/chroot/unstable-i386-sbuild apt installed apt-transport-https ... ok
+ /srv/chroot/unstable-i386-sbuild standard sources.list ... ok
+ Hit:1 http://ftp2.fr.debian.org/debian unstable InRelease
+ Hit:2 http://mirrors.kernel.org/debian unstable InRelease
+ /srv/chroot/unstable-i386-sbuild apt update ... failed
+ /srv/chroot/unstable-i386-sbuild apt cache cleaned ... ok
+ mordor chroot /srv/chroot/unstable-i386-sbuild provisioned ... failed
+
+the properties are here
+ sbuild :: System -> Proxy -> RevertableProperty HasInfo
+ sbuild system proxy = Sbuild.schroot schrootname chroot
+ where
+ chroot = Chroot.debootstrapped Debootstrap.BuilddD chrootdir
+ & os system
+ & case proxy of
+ (Just p) -> "/etc/apt/apt.conf.d/01proxy" `File.hasContent` ["Acquire::http::Proxy \"" ++ p ++ "\";"]
+ Nothing -> doNothing
+ & Apt.installed ["apt-transport-https"]
+ & Apt.stdSourcesList
+ & Apt.update `onChange` Apt.upgrade
+ & Apt.cacheCleaned
+ schrootname = Sbuild.schrootname system
+ chrootdir = "/srv/chroot" </> schrootname
+
+so the update failed and the solution seems to be
+
+ dpkg --configure -a
+
+Is it possible to deal with this problem in the update property in order to make it transparent for the users.
+
+Cheers
+
+Frederic
diff --git a/doc/forum/chroot_issue_when_upgrading/comment_2_be3846f1cf7853beb486afc2077cd8b2._comment b/doc/forum/chroot_issue_when_upgrading/comment_2_be3846f1cf7853beb486afc2077cd8b2._comment
new file mode 100644
index 00000000..6999ceb1
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading/comment_2_be3846f1cf7853beb486afc2077cd8b2._comment
@@ -0,0 +1,29 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2016-03-29T16:58:05Z"
+ content="""
+Hello, joey now that I installed 2.17.1 I can test the fix but...
+
+ [2016-03-29 16:50:06 UTC] call: apt-get [\"update\"]
+ [2016-03-29 16:50:06 UTC] fgProcess (\"apt-get\",[\"update\"])
+ E: dpkg was interrupted, you must manually run 'dpkg --configure -a' to correct the problem.
+ [2016-03-29 16:50:07 UTC] fgProcess done (\"apt-get\",[\"update\"])
+ [2016-03-29 16:50:07 UTC] process done ExitFailure 100
+
+my property is
+
+ chroot = Chroot.debootstrapped Debootstrap.BuilddD chrootdir
+ & os system
+ & case proxy of
+ (Just p) -> \"/etc/apt/apt.conf.d/01proxy\" `File.hasContent` [\"Acquire::http::Proxy \\"\" ++ p ++ \"\\";\"]
+ Nothing -> doNothing
+ & Apt.installed [\"apt-transport-https\"]
+ & Apt.stdSourcesList
+ & Apt.update `onChange` Apt.upgrade
+ & Apt.cacheCleaned
+
+so it failes in the Apt.update and do not reach Apt.upgrade
+so it seems that update should be fixed also :)
+
+"""]]
diff --git a/doc/forum/chroot_issue_when_upgrading/comment_2_eea48d51f241651935f695ea1dc7dd87._comment b/doc/forum/chroot_issue_when_upgrading/comment_2_eea48d51f241651935f695ea1dc7dd87._comment
new file mode 100644
index 00000000..654ea40c
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading/comment_2_eea48d51f241651935f695ea1dc7dd87._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-02-29T21:44:19Z"
+ content="""
+There are several ways this could happen, along the lines of a power
+failure or ctrl-c at the wrong time. A failing postinst may also cause
+apt to leave other packages un-configured, although `dpkg configure -a`
+probably won't recover from that case.
+
+I think it makes sense for Apt.upgrade to run `dpkg --configure -a`
+in case the last upgrade got into this state. I don't think it makes sense
+for Apt.install to do that (too much overhead to do it every time,
+and I don't think that unconfigured packages normally prevent installing
+of an unrelated package anyway). I've made a change along these lines.
+"""]]
diff --git a/doc/forum/chroot_issue_when_upgrading/comment_3_f902730900901dccdf2e290a176458f9._comment b/doc/forum/chroot_issue_when_upgrading/comment_3_f902730900901dccdf2e290a176458f9._comment
new file mode 100644
index 00000000..17c02fe7
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading/comment_3_f902730900901dccdf2e290a176458f9._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-03-29T20:49:32Z"
+ content="""
+Hmm, I don't ever remember seeing apt-get update need dpkg --configure -a.
+It's rather weird that it would; the files it updates are fully independent
+of the files dpkg does AIUI.
+"""]]
diff --git a/doc/forum/chroot_issue_when_upgrading/comment_4_4004abde37eb4bc7d845fb7bba2c635d._comment b/doc/forum/chroot_issue_when_upgrading/comment_4_4004abde37eb4bc7d845fb7bba2c635d._comment
new file mode 100644
index 00000000..65ca065e
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading/comment_4_4004abde37eb4bc7d845fb7bba2c635d._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 4"
+ date="2016-03-29T21:36:11Z"
+ content="""
+I found this in the apt code
+
+ #: apt-pkg/deb/debsystem.cc:82
+ msgid \"\"
+ \"dpkg was interrupted, you must manually run 'dpkg --configure -a' to correct \"
+ \"the problem. \"
+ msgstr \"\"
+
+"""]]
diff --git a/doc/forum/chroot_issue_when_upgrading/comment_5_fe9deffb0cd356787fed33a373115f73._comment b/doc/forum/chroot_issue_when_upgrading/comment_5_fe9deffb0cd356787fed33a373115f73._comment
new file mode 100644
index 00000000..43f12d0f
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading/comment_5_fe9deffb0cd356787fed33a373115f73._comment
@@ -0,0 +1,26 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 5"
+ date="2016-03-29T21:41:50Z"
+ content="""
+Here the c++ code of apt
+
+ // See if we need to abort with a dirty journal
+ if (CheckUpdates() == true)
+ {
+ close(d->LockFD);
+ d->LockFD = -1;
+ const char *cmd;
+ if (getenv(\"SUDO_USER\") != NULL)
+ cmd = \"sudo dpkg --configure -a\";
+ else
+ cmd = \"dpkg --configure -a\";
+ // TRANSLATORS: the %s contains the recovery command, usually
+ // dpkg --configure -a
+ return _error->Error(_(\"dpkg was interrupted, you must manually \"
+ \"run '%s' to correct the problem. \"), cmd);
+ }
+
+so there is a dirty journal. (maybe due to a power off during the chroot update)
+
+"""]]
diff --git a/doc/forum/chroot_issue_when_upgrading/comment_6_262df826e5bbd0130964e0433fb172f2._comment b/doc/forum/chroot_issue_when_upgrading/comment_6_262df826e5bbd0130964e0433fb172f2._comment
new file mode 100644
index 00000000..00a282bf
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading/comment_6_262df826e5bbd0130964e0433fb172f2._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2016-03-30T14:44:03Z"
+ content="""
+All right then, I've combined pendingConfigured into Apt.update.
+"""]]
diff --git a/doc/forum/chroot_issue_when_upgrading/comment_7_c682c5e99a1e9910771de0589d74657c._comment b/doc/forum/chroot_issue_when_upgrading/comment_7_c682c5e99a1e9910771de0589d74657c._comment
new file mode 100644
index 00000000..f39df6a1
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading/comment_7_c682c5e99a1e9910771de0589d74657c._comment
@@ -0,0 +1,36 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 7"
+ date="2016-04-01T05:47:33Z"
+ content="""
+Hello Joey
+
+with 2.17.2 I get this. (there is nevertheless a progression in the right direction :p)
+
+ [2016-04-01 07:42:02 CEST] process done ExitSuccess
+ /srv/chroot/unstable-i386-sbuild has Operating System (Debian Unstable) \"i386\" ... ok
+ /srv/chroot/unstable-i386-sbuild noop property ... ok
+ /srv/chroot/unstable-i386-sbuild apt installed apt-transport-https ... ok
+ /srv/chroot/unstable-i386-sbuild standard sources.list ... ok
+ Hit:1 http://ftp2.fr.debian.org/debian unstable InRelease
+ Hit:2 http://mirrors.kernel.org/debian unstable InRelease
+ Reading package lists...
+ Reading package lists...
+ Building dependency tree...
+ Reading state information...
+ You might want to run 'apt-get -f install' to correct these.
+ The following packages have unmet dependencies:
+ g++-5 : Depends: gcc-5-base (= 5.3.1-7) but 5.3.1-8 is installed
+ gcc-5 : Depends: cpp-5 (= 5.3.1-7) but 5.3.1-8 is installed
+ Depends: gcc-5-base (= 5.3.1-7) but 5.3.1-8 is installed
+ libgcc-5-dev : Depends: gcc-5-base (= 5.3.1-7) but 5.3.1-8 is installed
+ libstdc++-5-dev : Depends: gcc-5-base (= 5.3.1-7) but 5.3.1-8 is installed
+ libstdc++6 : Depends: gcc-5-base (= 5.3.1-7) but 5.3.1-8 is installed
+ /srv/chroot/unstable-i386-sbuild apt update ... failed
+ /srv/chroot/unstable-i386-sbuild apt cache cleaned ... ok
+ mordor chroot /srv/chroot/unstable-i386-sbuild provisioned ... failed
+ mordor replace /etc/schroot/chroot.d/unstable-i386-sbuild ... failed
+
+so now the proposition is to run `apt -f install`
+So what is the right way to solve this (I hope) last issue during chroot upgrade?
+"""]]
diff --git a/doc/forum/chroot_issue_when_upgrading/comment_8_d1c546c6f88035d40eca823d25d67e92._comment b/doc/forum/chroot_issue_when_upgrading/comment_8_d1c546c6f88035d40eca823d25d67e92._comment
new file mode 100644
index 00000000..9792a624
--- /dev/null
+++ b/doc/forum/chroot_issue_when_upgrading/comment_8_d1c546c6f88035d40eca823d25d67e92._comment
@@ -0,0 +1,21 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 8"""
+ date="2016-04-01T17:26:15Z"
+ content="""
+ -f, --fix-broken
+ Fix; attempt to correct a system with broken dependencies
+ in place. This option, when used with install/remove, can
+ omit any packages to permit APT to deduce a likely
+ solution. If packages are specified, these have to
+ completely correct the problem. The option is sometimes
+ necessary when running APT for the first time; APT itself
+ does not allow broken package dependencies to exist on a
+ system.
+
+So I don't see how you could get into this situation unless perhaps
+your debootstrap configuration gets into a broken dependency situation somehow.
+
+IIRC, apt-get -f install can decide to *remove* arbitrary packages as necessary
+to get to a sane dependency tree. So I'm very dubious about doing it by default.
+"""]]
diff --git a/doc/forum/cron_email.mdwn b/doc/forum/cron_email.mdwn
new file mode 100644
index 00000000..19f1bb4d
--- /dev/null
+++ b/doc/forum/cron_email.mdwn
@@ -0,0 +1,27 @@
+Hello,
+
+In my institut, I want to manage a few of my computers with propellor (the cluster will come ;)
+So I would like to add a MAILTO to cron.
+
+The best would be to configure exim4 to redirect all root email to my personnal mbox but for now I just want to do it for cron
+
+So I created a property for this.
+
+-- redirect all root email to an email
+redirectCronEmail :: String -> Property NoInfo
+redirectCronEmail email = "/etc/default/cron" `File.containsLine` ("MAILTO=" ++ email)
+ `requires` Apt.serviceInstalledRunning "cron"
+ `onChange` Service.restarted "cron"
+
+
+Would you be so kind to add an equivalent into Cron. (PS I do not know if my property is properly written)
+
+something like
+
+Cron.mailTO "toto@titi.org"
+
+or maybe this is not the right way to solve my problem.
+
+Cheers
+
+Frederic
diff --git a/doc/forum/delete_a_field__63__.mdwn b/doc/forum/delete_a_field__63__.mdwn
new file mode 100644
index 00000000..8e9e13e5
--- /dev/null
+++ b/doc/forum/delete_a_field__63__.mdwn
@@ -0,0 +1 @@
+"propellor --list-fields", "propellor --edit field context" and "propellor --set field context" are great, but is there a way to delete a field?
diff --git a/doc/forum/delete_a_field__63__/comment_1_157b488bf3e360570bd847d750ab0063._comment b/doc/forum/delete_a_field__63__/comment_1_157b488bf3e360570bd847d750ab0063._comment
new file mode 100644
index 00000000..5f3dd1a1
--- /dev/null
+++ b/doc/forum/delete_a_field__63__/comment_1_157b488bf3e360570bd847d750ab0063._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-06-29T20:40:33Z"
+ content="""
+I've added a --unset option now.
+"""]]
diff --git a/doc/forum/functions_that_yield_properties.mdwn b/doc/forum/functions_that_yield_properties.mdwn
new file mode 100644
index 00000000..eb4b4a45
--- /dev/null
+++ b/doc/forum/functions_that_yield_properties.mdwn
@@ -0,0 +1,21 @@
+I have a bunch of properties that need to know what my login name is on a host. I have a pure info property `SPW.myAccountIs` to set this as host info. I have a function
+
+ getMyAcc :: Propellor User
+
+which looks up this info or returns the default value 'spwhitton' if I didn't set a username on a host. It's easy to use `getMyAcc` in writing my own properties, but I want to use it with existing properties. I'd like to write
+
+ withMyAcc :: IsProp p => (User -> p) -> p
+
+so that for example I could say
+
+ & (withMyAcc $ \u -> User.accountFor u)
+
+Even better, I'd like to be able to say
+
+ stdMachine = propertyListWithAcc "standard Debian setup" $ \u -> props
+ & User.accountFor u
+ & Sudo.enabledFor u
+
+It seems like this ought to be possible; a property is something that does some stuff in the `Propellor` monad and has a few other attributes, and those monadic actions can be conditional on some data not yet provided. However, I can't figure out how to do this with propellor's type system. If it's possible, I'd welcome hints.
+
+--spwhitton
diff --git a/doc/forum/functions_that_yield_properties/comment_1_7de09397627186abda74d765f4194f79._comment b/doc/forum/functions_that_yield_properties/comment_1_7de09397627186abda74d765f4194f79._comment
new file mode 100644
index 00000000..c0310700
--- /dev/null
+++ b/doc/forum/functions_that_yield_properties/comment_1_7de09397627186abda74d765f4194f79._comment
@@ -0,0 +1,29 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-06-02T21:10:20Z"
+ content="""
+You can use `ensureProperty` to do this.
+
+ withMyAcc desc mkp = property' desc $ \w ->
+ u <- getMyAcc
+ ensureProperty w (mkp u)
+
+The type of this will be somewhat more complex than the one you gave,
+but it should work.
+
+Alas a description has to be provided to withMyAcc. It cannot reuse the
+description of `mkp` because to get a property that it can introspect for its
+description, a User has to be provided, and the User can only be determined by
+running Propellor (IO) action getMyAcc. You might be able to finesse this
+by using a monoidial value and get the description of `mkp mempty`.
+
+Or, you could do something like this to tie the knot. I don't know if this
+is a good idea (it might even `<<loop>>`), but it illustrates the core
+problem nicely; to get at the Info, we need a Host, but to get a Host, we
+need to already know its properties.
+
+ foo :: Host
+ foo = host "foo.example.com" $ props
+ & withMyAcc (hostInfo foo) User.accountFor
+"""]]
diff --git a/doc/forum/functions_that_yield_properties/comment_2_1abdc8ae6e1a00f02fa0130d845ec236._comment b/doc/forum/functions_that_yield_properties/comment_2_1abdc8ae6e1a00f02fa0130d845ec236._comment
new file mode 100644
index 00000000..34a14616
--- /dev/null
+++ b/doc/forum/functions_that_yield_properties/comment_2_1abdc8ae6e1a00f02fa0130d845ec236._comment
@@ -0,0 +1,23 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-06-02T22:21:52Z"
+ content="""
+Another, simpler approach that I often use in my config.hs:
+
+ foo :: Host
+ foo = host "foo.example.com" $ props
+ & User.accountFor myacc
+ & Sudo.enabledFor myacc
+ where
+ myacc = "joey"
+
+You can also bundle up a bunch of properties that
+each need a User into a single combined
+`User -> Property DebianLike`
+
+ myAccountIs :: User -> Property DebianLike
+ myAccountIs u = propertyList ("my user is " ++ u) $ props
+ & User.accountFor u
+ & Sudo.enabledFor u
+"""]]
diff --git a/doc/forum/functions_that_yield_properties/comment_3_76f4a92cf26ae2fcc3152a0f1a19f516._comment b/doc/forum/functions_that_yield_properties/comment_3_76f4a92cf26ae2fcc3152a0f1a19f516._comment
new file mode 100644
index 00000000..7b1954bb
--- /dev/null
+++ b/doc/forum/functions_that_yield_properties/comment_3_76f4a92cf26ae2fcc3152a0f1a19f516._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 3"
+ date="2016-06-05T06:13:05Z"
+ content="""
+> The type of this will be somewhat more complex than the one you gave, but it should work.
+
+GHC's inferred type is not something I can understand, and I suspect that it is far more general than it needs to be. In this sort of situation, are their strategies one can employ to write a sensible type signature? I think that the only thing I need to restrict is avoiding trying to ensure properties with info.
+
+> You might be able to finesse this by using a monoidial value and get the description of mkp mempty.
+
+Could you expand a little on this suggestion, please? I want to be able to use unmodified core properties like `User.accountFor`, and that takes a non-monoidal `User`.
+
+> Or, you could do something like this to tie the knot. I don't know if this is a good idea (it might even <<loop>>), but it illustrates the core problem nicely; to get at the Info, we need a Host, but to get a Host, we need to already know its properties.
+
+This seems to work!
+"""]]
diff --git a/doc/forum/functions_that_yield_properties/comment_4_886daf04a0fa9e6d0dd1e9ef4cc9b63f._comment b/doc/forum/functions_that_yield_properties/comment_4_886daf04a0fa9e6d0dd1e9ef4cc9b63f._comment
new file mode 100644
index 00000000..aab4f6ed
--- /dev/null
+++ b/doc/forum/functions_that_yield_properties/comment_4_886daf04a0fa9e6d0dd1e9ef4cc9b63f._comment
@@ -0,0 +1,23 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-06-06T20:58:37Z"
+ content="""
+`Maybe a` is a Monoid, so something along that line was what I was
+thinking.
+
+----
+
+ withMyAcc
+ :: (SingI outer, Cannot_ensureProperty_WithInfo inner ~ 'True,
+ NotSuperset (Targets inner) (Targets outer) ~ 'CanCombine)
+ => Desc
+ -> (User -> Property (MetaTypes inner))
+ -> Property (MetaTypes outer)
+
+The complicated constraints there are inherited from the use of `ensureProperty`.
+
+A less general form of that is:
+
+ withMyAcc :: Desc -> (User -> Property DebianLike) -> Property DebianLike
+"""]]
diff --git a/doc/forum/gitpush_problem.mdwn b/doc/forum/gitpush_problem.mdwn
new file mode 100644
index 00000000..ced4305b
--- /dev/null
+++ b/doc/forum/gitpush_problem.mdwn
@@ -0,0 +1,68 @@
+Hello, since a few days I got this error message when I am doing
+
+This is on a Debian unstable computer. I do no tknow if this is related to the
+git 2.4.x -> 2.5.x upgrade
+
+
+:~/.propellor$ propellor
+Building propellor-2.6.0...
+Preprocessing library propellor-2.6.0...
+In-place registering propellor-2.6.0...
+Preprocessing executable 'propellor' for propellor-2.6.0...
+Preprocessing executable 'propellor-config' for propellor-2.6.0...
+Propellor build ... done
+Enter passphrase for key '/home/picca/.ssh/id_rsa':
+Pull from central git repository ... done
+Building propellor-2.6.0...
+Preprocessing library propellor-2.6.0...
+In-place registering propellor-2.6.0...
+Preprocessing executable 'propellor' for propellor-2.6.0...
+Preprocessing executable 'propellor-config' for propellor-2.6.0...
+Propellor build ... done
+[master 08f2f53] propellor spin
+Git commit ... done
+Enter passphrase for key '/home/picca/.ssh/id_rsa':
+Décompte des objets: 1, fait.
+Écriture des objets: 100% (1/1), 202 bytes | 0 bytes/s, fait.
+Total 1 (delta 0), reused 0 (delta 0)
+To ssh://xxxxxxxxxxxxxxxxxxxxxxxxxxxx/propellor.git
+ 3a4d960..08f2f53 master -> master
+Push to central git repository ... done
+root@xxxxxx's password:
+Depuis git://xxxxxxxxxxxxxxxxxxxx/propellor
+ 3a4d960..08f2f53 master -> origin/master
+Pull from central git repository ... done
+Sending privdata (11 bytes) to mordor ... done
+error: unknown option `gitpush'
+usage : git fetch [<options>] [<dépôt> [<spécification-de-référence>...]]
+ ou : git fetch [<options>] <groupe>
+ ou : git fetch --multiple [<options>] [(<dépôt> | <groupe>)...]
+ ou : git fetch --all [<options>]
+
+ -v, --verbose être plus verbeux
+ -q, --quiet être plus silencieux
+ --all récupérer depuis tous le dépôts distants
+ -a, --append ajouter à .git/FETCH_HEAD au lieu de l'écraser
+ --upload-pack <chemin>
+ chemin vers lequel télécharger le paquet sur le poste distant
+ -f, --force forcer l'écrasement de la branche locale
+ -m, --multiple récupérer depuis plusieurs dépôts distants
+ -t, --tags récupérer toutes les étiquettes et leurs objets associés
+ -n ne pas récupérer toutes les étiquettes (--no-tags)
+ -p, --prune éliminer les branches de suivi distant si la branche n'existe plus dans le dépôt distant
+ --recurse-submodules[=<à la demande>]
+ contrôler la récupération récursive dans les sous-modules
+ --dry-run simuler l'action
+ -k, --keep conserver le paquet téléchargé
+ -u, --update-head-ok permettre la mise à jour de la référence HEAD
+ --progress forcer l'affichage de l'état d'avancement
+ --depth <profondeur> approfondir l'historique d'un clone superficiel
+ --unshallow convertir en un dépôt complet
+ --update-shallow accepter les références qui mettent à jour .git/shallow
+ --refmap <correspondance de référence>
+ spécifier une correspondance de référence pour la récupération
+
+propellor: <stdout>: hIsTerminalDevice: illegal operation (handle is closed)
+error: git-upload-pack died of signal 13
+Sending git update to mordor ... failed
+propellor: user error (ssh ["-o","ControlPath=/xxxxxxxxxxxxxxxxxxxx.sock","-o","ControlMaster=auto","-o","ControlPersist=yes","root@xxxxxx","sh -c 'if [ ! -d /usr/local/propellor/.git ] ; then (if ! git --version >/dev/null; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git; fi && echo STATUSNeedGitClone) || echo STATUSNeedPrecompiled ; else cd /usr/local/propellor && if ! cabal configure >/dev/null 2>&1; then ( apt-get update ; apt-get --no-upgrade --no-install-recommends -y install gnupg ; apt-get --no-upgrade --no-install-recommends -y install ghc ; apt-get --no-upgrade --no-install-recommends -y install cabal-install ; apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-missingh-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-hslogger-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-unix-compat-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-ansi-terminal-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-ifelse-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-network-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-quickcheck2-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-mtl-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-transformers-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-exceptions-dev ; cabal update ; cabal install --only-dependencies ) || true; fi&& if ! test -x ./propellor; then cabal configure && cabal build && ln -sf dist/build/propellor-config/propellor-config propellor; fi;if test -x ./propellor && ! ./propellor --check 2>/dev/null; then cabal clean && cabal configure && cabal build && ln -sf dist/build/propellor-config/propellor-config propellor; fi && ./propellor --boot mordor ; fi'"] exited 1)
diff --git a/doc/forum/gitpush_problem/comment_1_ba6fb30ea2e2759776351408a3a69b44._comment b/doc/forum/gitpush_problem/comment_1_ba6fb30ea2e2759776351408a3a69b44._comment
new file mode 100644
index 00000000..11d24d50
--- /dev/null
+++ b/doc/forum/gitpush_problem/comment_1_ba6fb30ea2e2759776351408a3a69b44._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-07-30T15:00:57Z"
+ content="""
+About all I can tell from this is that "git fetch" is failing, and
+apparently complaining about being passed a "gitpush" option.
+
+Since the only occurrance of "gitpush" is a internal flag that propellor
+passes to itself, and not to git fetch, I don't know why your propellor
+would be doing this. Perhaps if you turn on `PROPELLOR_DEBUG` you'll find
+out more.
+"""]]
diff --git a/doc/forum/gitpush_problem/comment_2_342b7657b964e836840a78b85a09749b._comment b/doc/forum/gitpush_problem/comment_2_342b7657b964e836840a78b85a09749b._comment
new file mode 100644
index 00000000..55bc85f6
--- /dev/null
+++ b/doc/forum/gitpush_problem/comment_2_342b7657b964e836840a78b85a09749b._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-07-30T15:29:46Z"
+ content="""
+Hmm, I do reproduce same problem spinning a remote host that's been
+upgraded to this git version.
+"""]]
diff --git a/doc/forum/gitpush_problem/comment_3_419baa6f1738200b1368566a2e136d36._comment b/doc/forum/gitpush_problem/comment_3_419baa6f1738200b1368566a2e136d36._comment
new file mode 100644
index 00000000..830ee7b0
--- /dev/null
+++ b/doc/forum/gitpush_problem/comment_3_419baa6f1738200b1368566a2e136d36._comment
@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-07-30T15:32:50Z"
+ content="""
+What's happening here is propellor is running: git pull --progress
+--upload-pack command, where command is "./propellor --gitpush".
+
+Apparently git's --upload-pack option parsing has changed in a way that
+breaks this.
+
+I think this is a straight-up git bug. I have reported the bug to the
+git mailing list.
+
+May have to work around the bug by just passing "./propellor" to
+--upload-pack, and using environment variables to tell it what to do.
+
+Erm.. AFAIKS, git pull is no longer running --upload-pack specified
+command at all. So it seems git has completely defeated how propellor --spin
+sends a git push over its ssh channel. I don't have any prospect of a fix
+right now.
+"""]]
diff --git a/doc/forum/gitpush_problem/comment_4_3843d9b82431f175f9194159a73a1fc9._comment b/doc/forum/gitpush_problem/comment_4_3843d9b82431f175f9194159a73a1fc9._comment
new file mode 100644
index 00000000..7e8bcdb2
--- /dev/null
+++ b/doc/forum/gitpush_problem/comment_4_3843d9b82431f175f9194159a73a1fc9._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2015-07-30T16:07:14Z"
+ content="""
+I have found a workaround -- Since git pull is broken, it can instead do a
+git fetch followed by a git merge. I've put that fix in place.
+
+Unfortunately, --spin can't be used to deploy a fix that breaks the --spin
+transport! So, hosts that are suffering from this problem will need to have
+their propellor git repos updated in some other way, like pulling from a
+central git repo.
+"""]]
diff --git a/doc/forum/gitpush_problem/comment_5_4075a141f6345267ade09f6c793dc2c8._comment b/doc/forum/gitpush_problem/comment_5_4075a141f6345267ade09f6c793dc2c8._comment
new file mode 100644
index 00000000..b38bb004
--- /dev/null
+++ b/doc/forum/gitpush_problem/comment_5_4075a141f6345267ade09f6c793dc2c8._comment
@@ -0,0 +1,33 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="try to use the fix"
+ date="2015-07-30T17:52:53Z"
+ content="""
+Hello I built the debian package of your git repository with debuild and installed it.
+
+then I run propellor in order to upgrade my local repo
+
+:~/.propellor$ propellor
+** warning: ** Your /home/picca/.propellor is out of date..
+ A newer upstream version is available in /usr/src/propellor/propellor.git
+ To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/upstream/master to it. Then run propellor again.
+
+So I followed the advices, found the most recent commit which was the one created when I run for the first time propellor cb7f1acc108609b345dbec26d8113513bf7b4ece
+
+But now when I run propellor,I get thir message
+
+:~/.propellor$ propellor
+** warning: ** Your /home/picca/.propellor is out of date..
+ A newer upstream version is available in /usr/src/propellor/propellor.git
+ To merge it, run: git merge upstream/master
+
+
+But when I try the merge,
+
+~/.propellor$ git merge upstream/master
+Already up-to-date.
+
+
+so nothing happend
+
+"""]]
diff --git a/doc/forum/gitpush_problem/comment_6_464257a98e09dfe17e515242ae819fab._comment b/doc/forum/gitpush_problem/comment_6_464257a98e09dfe17e515242ae819fab._comment
new file mode 100644
index 00000000..2f3b4bc6
--- /dev/null
+++ b/doc/forum/gitpush_problem/comment_6_464257a98e09dfe17e515242ae819fab._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2015-08-06T16:14:04Z"
+ content="""
+Hmm, not sure that's going on there, perhaps you've found a way to break
+the propellor debian package, which has not been much used AFAIK.
+
+Seems to me it would be easier to pull the fix into your propellor
+repository from eg, propellor's public git repository.
+"""]]
diff --git a/doc/forum/gitpush_problem/comment_7_1cfed50e43cc4ec816999f4f1de79762._comment b/doc/forum/gitpush_problem/comment_7_1cfed50e43cc4ec816999f4f1de79762._comment
new file mode 100644
index 00000000..0fb091e5
--- /dev/null
+++ b/doc/forum/gitpush_problem/comment_7_1cfed50e43cc4ec816999f4f1de79762._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 7"
+ date="2015-08-19T07:40:38Z"
+ content="""
+Yes you are right I generated the Debian package but not from a tagged version.
+Now that I created the 2.7.1 version from the tag, it works.
+
+thanks
+"""]]
diff --git a/doc/forum/gnupg2.mdwn b/doc/forum/gnupg2.mdwn
new file mode 100644
index 00000000..3849ba84
--- /dev/null
+++ b/doc/forum/gnupg2.mdwn
@@ -0,0 +1,5 @@
+Is there a way to enable gnupg2 support?
+
+I now use gnupg2 on my laptop, and gpg 1.4 cannot connect to gnupg-agent 2.1... As a result, I have to enter my password several times when running propellor, while gpg-agent is actually available to gpg 2.1, available as command gpg2.
+
+ gpg: gpg-agent is not available in this session
diff --git a/doc/forum/gnupg2/comment_1_4f07e458eb0c6d124c6c715eea9e20f4._comment b/doc/forum/gnupg2/comment_1_4f07e458eb0c6d124c6c715eea9e20f4._comment
new file mode 100644
index 00000000..fe67a25d
--- /dev/null
+++ b/doc/forum/gnupg2/comment_1_4f07e458eb0c6d124c6c715eea9e20f4._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-08-26T18:21:45Z"
+ content="""
+The two are very command-line compatable, and I'd be surprised if propellor
+hits any incompatabilities.
+
+So, if your distribution has a way to make "gpg" run gpg2, that should d
+it. If not, `git grep '"gpg"'` will find the few places the command name
+needs to be changed. Those could be centralized into one place for easier
+configuation; send patches.
+"""]]
diff --git a/doc/forum/gnupg2/comment_2_9070abc82d8aa259aca187ed5d6638cc._comment b/doc/forum/gnupg2/comment_2_9070abc82d8aa259aca187ed5d6638cc._comment
new file mode 100644
index 00000000..d8233cee
--- /dev/null
+++ b/doc/forum/gnupg2/comment_2_9070abc82d8aa259aca187ed5d6638cc._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-12-30T19:02:30Z"
+ content="""
+I've merged a patch that adds a GNUPGBIN environment variable.
+
+It might make sense for propellor to look at git's gpg.program
+configuration and use it if set. Probably a propellor user wants to use the
+same gpg program for both signing and verifying their git commit and for
+propellor's privdata.
+"""]]
diff --git a/doc/forum/gnupg2/comment_3_996fe5791c175d709217875b5e751c4f._comment b/doc/forum/gnupg2/comment_3_996fe5791c175d709217875b5e751c4f._comment
new file mode 100644
index 00000000..ead20fb6
--- /dev/null
+++ b/doc/forum/gnupg2/comment_3_996fe5791c175d709217875b5e751c4f._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-01-03T20:57:42Z"
+ content="""
+gpg.program is also honored now
+"""]]
diff --git a/doc/forum/how_to_install_a_cluster_with_propellor.mdwn b/doc/forum/how_to_install_a_cluster_with_propellor.mdwn
new file mode 100644
index 00000000..6107061b
--- /dev/null
+++ b/doc/forum/how_to_install_a_cluster_with_propellor.mdwn
@@ -0,0 +1,7 @@
+Hello joey,
+
+I would like to know your opinion, on the best way to install from scratch a cluster of at least 20 machines all identical, with propellor.
+I saw the FAI project, but I am wondering if this can be achieved with propellor only.
+The installation should be done remotly without human intervention except the propellor config :) and Indeed power on the cluster :)
+
+Fred
diff --git a/doc/forum/how_to_install_a_cluster_with_propellor/comment_1_e6860056989da82fd7cd8f374e209548._comment b/doc/forum/how_to_install_a_cluster_with_propellor/comment_1_e6860056989da82fd7cd8f374e209548._comment
new file mode 100644
index 00000000..571970df
--- /dev/null
+++ b/doc/forum/how_to_install_a_cluster_with_propellor/comment_1_e6860056989da82fd7cd8f374e209548._comment
@@ -0,0 +1,73 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-08-31T20:55:38Z"
+ content="""
+Don't know that I have an answer to this question. I've never done that. :)
+
+I think it breaks down into several independant questions,
+although due to lack of experience I could be missing some.
+
+## Initial installation
+
+I'm working on getting propellor to be able to
+generate bootable disk images. <http://joeyh.name/blog/entry/then_and_now/>
+Once that works, it might provide a way to generate images to install
+machines in a cluster. But, any method for installing the base system
+and propellor could work too, and there are probably many cluster-specific
+OS installation tools.
+
+## Expressing the cluster in a propellor config file
+
+Propellor's config is a list of hosts, and `defaultMain` looks at the hostname
+to determine which host it is provisioning. A cluster might have many hosts
+that are very similar or identical, and you probably want it to be easy to
+add more.
+
+So, you'll probably want a way to generate a Host from a HostName with the
+desired Properties you want nodes in the cluster to have:
+
+ clusterNode :: HostName -> Host
+ clusterNode hn = host hn
+ & foo
+ & bar
+
+Then you could feed a list of hostnames to defaultMain to finish the
+config file:
+
+ main :: IO ()
+ main = defaultMain (map clusterNode hostnames)
+ where
+ hostnames =
+ [ "node1"
+ , "node2"
+ -- etc
+ ]
+ -- alternatively...
+ -- hostnames = map (\n -> "node" ++ show n) [1..100]
+
+Or, you could even look up the current hostname, and feed defaultMain
+a Host containing that hostname; so this single propellor configuration
+could be used on any number of hosts:
+
+ main = IO ()
+ main = do
+ hn <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
+ defaultMain [ clusterNode hn ]
+
+## Triggering propellor on nodes
+
+When you change your propellor config.hs, you need a way to trigger the
+nodes to update. Propellor has a couple of different ways to do this;
+you could just use Propellor.Property.Cron.runPropellor to run it periodically
+from cron on all the nodes. (With a central git repository holding the
+propellor configuration, naturally.)
+
+Or you could run propellor --spin against all the hosts in the
+cluster to push out a change. (It would be a nice enhancement to make
+propellor be able to --spin multiple hosts concurrently; there's nothing
+really preventing it but the output would be a mess.)
+
+There's certianly room for improvement here. Also you'll probably want some
+monitoring, which propellor doesn't provide in itself, etc.
+"""]]
diff --git a/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac.mdwn b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac.mdwn
new file mode 100644
index 00000000..c88defcf
--- /dev/null
+++ b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac.mdwn
@@ -0,0 +1,12 @@
+Hello,
+
+I am trying propellor on Debian Jessie (haskell is fantastic for this sort or things) to setup one of my computer.
+
+On my network, the system administrator set proxies for http and https.
+These information are available via a http://proxy/proxy.pac URL.
+
+So I would like to know what should be done to extract this information and set it for all users on the system ?
+
+Cheers
+
+Frederic
diff --git a/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_1_69d7c8fb1d62300456575bb10e935d69._comment b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_1_69d7c8fb1d62300456575bb10e935d69._comment
new file mode 100644
index 00000000..6bf8844d
--- /dev/null
+++ b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_1_69d7c8fb1d62300456575bb10e935d69._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2014-11-25T15:44:13Z"
+ content="""
+You could, for example, use Propellor.Propety.Cmd.cmdProperty
+to run a command that sets up the proxying. If there's not a single command
+that does it, you could cause propellor to fetch the url and deploy the
+info itself.
+"""]]
diff --git a/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_2_da30b2621493e48ceabcfa5732dbcdf8._comment b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_2_da30b2621493e48ceabcfa5732dbcdf8._comment
new file mode 100644
index 00000000..8458ee49
--- /dev/null
+++ b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_2_da30b2621493e48ceabcfa5732dbcdf8._comment
@@ -0,0 +1,19 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2014-11-25T17:55:25Z"
+ content="""
+In my case I need to wget the proxy.pac file and parse it to find the right proxy.
+
+what worried me is that these proxy.pac things are dynamical depending on the ip of the sender AND the receive.
+It work nicely with web browser, but not with the unix http_proxy and HTTPS_PROXY env.
+
+nevertheless, I can create something to parse my local setup and extract the right http_proxy.
+
+Is there something available in Propellor to set a global environment variable in /etc/environment (the right place for this ?)
+
+cheers
+
+Frederic
+
+"""]]
diff --git a/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_3_bd76d169af2ef2f154ad1f0f64506661._comment b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_3_bd76d169af2ef2f154ad1f0f64506661._comment
new file mode 100644
index 00000000..9bdcb4df
--- /dev/null
+++ b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_3_bd76d169af2ef2f154ad1f0f64506661._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2014-11-25T19:37:46Z"
+ content="""
+There's no Property that handles setting global environment currently, but
+it's a reasonable one to add.
+
+I think that /etc/environment is read by `pam_env` logins, but maybe not
+other things, so dunno.
+"""]]
diff --git a/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_4_a6a49d35ee8a05abc982049b55d0397c._comment b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_4_a6a49d35ee8a05abc982049b55d0397c._comment
new file mode 100644
index 00000000..d2a0b45e
--- /dev/null
+++ b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_4_a6a49d35ee8a05abc982049b55d0397c._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 4"
+ date="2014-11-25T20:01:12Z"
+ content="""
+I saw that there is an haskell binding for augeas.
+
+Maybe this could be a nice uniform interface to deal with all the system configuration files.
+then no need to deal with the config file formats.
+
+"""]]
diff --git a/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_5_7783b8a96c8032a39ff3b5b446a976ed._comment b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_5_7783b8a96c8032a39ff3b5b446a976ed._comment
new file mode 100644
index 00000000..d670fa3b
--- /dev/null
+++ b/doc/forum/how_to_set_the_proxy_using_an_automatix_proxy.pac/comment_5_7783b8a96c8032a39ff3b5b446a976ed._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 5"
+ date="2014-11-27T08:17:36Z"
+ content="""
+Just looked at augeas, and add it to propellor would be great. Much more robust than Propellor.Property.File.{containsLine,containsLines,lacksLine}, at least.
+"""]]
diff --git a/doc/forum/howto_mapM_RevertableProperty.mdwn b/doc/forum/howto_mapM_RevertableProperty.mdwn
new file mode 100644
index 00000000..7ebcbd47
--- /dev/null
+++ b/doc/forum/howto_mapM_RevertableProperty.mdwn
@@ -0,0 +1,52 @@
+Hello
+
+I have this kind of property
+
+ myProperty :: Conf -> RevertableProperty NoInfo
+
+
+now I have a [Conf] and I want to create also a RevertableProperty NoInfo which apply myProperty for each Conf
+
+I tried to find an equivalent of mapM for properties but I found nothing which works as expected.
+
+I tried with combineProperties but it failed also with a "cryptic message"
+mpoints is the [Conf]
+
+
+ src/config.hs:250:17:
+ Couldn't match type `CInfo
+ (PropertyListType (Property [NoInfo]))
+ (PropertyListType (Property [NoInfo]))'
+ with `NoInfo'
+ Expected type: RevertableProperty NoInfo
+ Actual type: RevertableProperty
+ (CInfo
+ (PropertyListType (Property [NoInfo]))
+ (PropertyListType (Property [NoInfo])))
+ In the expression: mount <!> umount
+ In an equation for `mountExp':
+ mountExp b
+ = mount <!> umount
+ where
+ mount
+ = combineProperties
+ "mount nfs files" (mapM mount'' mpoints)
+ umount
+ = combineProperties
+ "umount nfs files" (mapM umount'' mpoints)
+ mpoints
+ = [MountConf
+ "nfs"
+ ("ruche-"
+ ++
+ beamline ++ ".mydomain.org:/" ++ beamline ++ "-users")
+ ("/nfs/ruche-" ++ beamline ++ "/" ++ beamline ++ "-users"),
+ ....]
+ beamline = show b
+
+What is the right way to create a RevertableProperty from a list of RevertableProperty
+
+thanks
+
+Frederic
+
diff --git a/doc/forum/howto_mapM_RevertableProperty/comment_1_c2800340a5361add82f5e9e30b56b18c._comment b/doc/forum/howto_mapM_RevertableProperty/comment_1_c2800340a5361add82f5e9e30b56b18c._comment
new file mode 100644
index 00000000..66ac9a4f
--- /dev/null
+++ b/doc/forum/howto_mapM_RevertableProperty/comment_1_c2800340a5361add82f5e9e30b56b18c._comment
@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-02-08T15:00:26Z"
+ content="""
+combineProperties takes a list of PropertyListType, which is a type family
+consisting of [Property NoInfo] and [Property HasInfo]. So, you need to get
+from RevertableProperty NoInfo to one of those. `toProp` can do that.
+
+ combineProperties "desc" (map (toProp . myProperty) confs)
+
+But! I had a look and it was easy to make [RevertableProperty i] an
+instance of PropertyListType, which makes what you already tried type check
+too. I've done so in git.
+
+It would perhaps be nice to make lists of various sorts of properties
+instances of Traversable, so that mapM etc could be used over them. That
+would need some kind of monad for combining properties though, which does
+not currently exist. Might make more sense to make an instance of Foldable
+or just Monoid for properties. Any improvements in this area would be
+appreciated!
+"""]]
diff --git a/doc/forum/howto_mapM_RevertableProperty/comment_2_1327f1f218433ce262f871771c43452c._comment b/doc/forum/howto_mapM_RevertableProperty/comment_2_1327f1f218433ce262f871771c43452c._comment
new file mode 100644
index 00000000..20f6e640
--- /dev/null
+++ b/doc/forum/howto_mapM_RevertableProperty/comment_2_1327f1f218433ce262f871771c43452c._comment
@@ -0,0 +1,23 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2016-02-10T06:41:49Z"
+ content="""
+Thanks a lot joey :)
+
+I am learning haskell for now and I am not very confortable yet with the haskell Monoid, functor, applicative and monad.
+
+So what you are saying is that it would be great to do something like
+
+ instance monoid Property where
+ mempty = doNothing
+ mappend p1 p2 = combineProperty [p1, p2]
+ mconcat ps = combineProperty ps
+
+in order to combine properties.
+my question is why did you choose to create combineProperty instead of a Monoid at first ?
+
+thanks
+
+Frederic
+"""]]
diff --git a/doc/forum/howto_mapM_RevertableProperty/comment_3_7e519cc5f1c07b66561ec31866ddbc8a._comment b/doc/forum/howto_mapM_RevertableProperty/comment_3_7e519cc5f1c07b66561ec31866ddbc8a._comment
new file mode 100644
index 00000000..79ca2d93
--- /dev/null
+++ b/doc/forum/howto_mapM_RevertableProperty/comment_3_7e519cc5f1c07b66561ec31866ddbc8a._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-02-10T16:09:08Z"
+ content="""
+Would probably be better to use `before`, since `combineProperties`
+needs a description of the combined properties.
+
+Using `doNothing` is kind of a hack, it would make propellor say it was
+running "noop property". Perhaps better to use a SemiGroup than a Monoid.
+"""]]
diff --git a/doc/forum/mailname_set_by_Propellor.Property.Hostname.sane.mdwn b/doc/forum/mailname_set_by_Propellor.Property.Hostname.sane.mdwn
new file mode 100644
index 00000000..3c599a5b
--- /dev/null
+++ b/doc/forum/mailname_set_by_Propellor.Property.Hostname.sane.mdwn
@@ -0,0 +1 @@
+I'm not sure the current default behaviour of Propellor.Property.Hostname.sane is as sane as it claims :-). To me, "/etc/mailname" should be set to the current "basehost.domain" by default, not to "domain". Thoughts?
diff --git a/doc/forum/mailname_set_by_Propellor.Property.Hostname.sane/comment_1_199da2bf7793c33841d21599703a3006._comment b/doc/forum/mailname_set_by_Propellor.Property.Hostname.sane/comment_1_199da2bf7793c33841d21599703a3006._comment
new file mode 100644
index 00000000..47e7e669
--- /dev/null
+++ b/doc/forum/mailname_set_by_Propellor.Property.Hostname.sane/comment_1_199da2bf7793c33841d21599703a3006._comment
@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-23T16:31:19Z"
+ content="""
+Well, for a hostname like "foo.example.com", it's right to use example.com
+for the mailname. OTOH, for hostname "example.com", it currently uses
+"com" for the mailname, which is certianly wrong. (It also uses "example"
+for the hostname, which I dunno if is right or not, probably a matter of
+opinion.)
+
+I've special cased it to require at least one dot in the domain, and
+parameterized domain extraction for cases where the default method
+doesn't work.
+"""]]
diff --git a/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__.mdwn b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__.mdwn
new file mode 100644
index 00000000..0a50fc91
--- /dev/null
+++ b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__.mdwn
@@ -0,0 +1,177 @@
+Having taken the inital hurdle of getting propellor running
+(cf. my last post in this forum), I am beginning to like propellor
+quite a lot. - This comes not too much as a surprise, as I am
+a Haskeller really. - I would love to use it for all my configuration
+needs, and to that end ditch ansible.
+
+Propellor's biggest show stopper for me is this (maybe I am misunderstanding
+propellor?):
+
+I can run
+
+```
+ propellor --spin myhost
+```
+
+from the command line, and all the tasks/properties that I have
+defined myhost to have beforehand will be executed/realized/configured.
+
+Say eg. I haved defined (sorry for the bad formatting,
+seems I have to do it line by line to get the markdown look nice)
+
+```
+myhost :: Host
+```
+
+```
+myhost = host "myhost"
+ & os (System (Debian Testing) "amd64")
+ & emacs
+ & apt
+```
+
+```
+emacs :: Property HasInfo
+```
+
+```
+emacs = propertyList "install & configure emacs" $ props
+ & Apt.installed ["emacs"
+ , "auto-complete-el"]
+```
+
+```
+ apt :: Property HasInfo
+```
+
+```
+apt = propertyList "apt update + upgrade" $ props
+ & Apt.update
+ & Apt.upgrade
+```
+
+
+Then running
+
+```
+ propellor --spin myhost
+```
+
+will make sure, that emacs is installed, and all my
+packages on myhost are up to date.
+
+It does so every time I run propellor, but normally I install
+emacs only once (and I know it's installed), whereas
+the apt update+upgrade combo I would want to run every other day.
+
+So what I would like is this: have just a minimal config for
+myhost, like this:
+
+```
+myhost :: Host
+```
+
+```
+myhost = host "myhost"
+ & os (System (Debian Testing) "amd64")
+```
+
+and then run a task (require a property ?) on myhost, somehow
+from the command line, like this
+
+```
+ propellor --spin myhost --task apt
+```
+
+Many other properties / installation steps I could run in this
+manner, like installing emacs initially
+
+```
+ propellor --spin myhost --task emacs
+```
+
+In ansible I can do this with playbooks:
+
+```
+ ansible-playbook -l myhost apt.yml
+```
+
+with some preconfigured playbook apt.yml that does just
+the apt update + upgrade task and nothing else. But I would
+have other tasks in other playbooks of course: I can install & configure
+emacs on myhost
+
+```
+ ansible-playbook -l myhost emacs.yml
+```
+
+etc.
+
+Related to that (but maybe not strictly the same question):
+
+I wouldn't mind writing my own haskell script that does
+the command line parsing (with optparse applicative eg):
+I could have options for
+
+```
+ --host (myhost/...)
+```
+
+and
+
+```
+ --task (emacs/apt/...)
+```
+
+and then just call into propellor. Unfortunately propellor's
+defaultMain does more than I want: gets the command line
+from processCmdLine.
+
+So I tried to create my own otherMain (similar to defaultMain,
+but would let me do my own command line parsing):
+
+```
+ otherMain :: [Host] -> CmdLine -> IO ()
+```
+
+but then at some point just gave up: for one thing: things
+were getting complicated, because of all the indirection:
+the propellor command line tool recompiles itself (?),
+does all this git stuff etc.
+
+And then: maybe I am approaching things in the wrong direction:
+maybe it's just not meant to be used that way
+(but ansible works fine for me in this regard)?
+
+And I thought: I don't really want to start a major programming
+task just to get this thing working, the way that seems
+reasonable to me. Or maybe it's possible already, and I just
+don't know how to use it? (So I am stuck with ansible for the time
+being).
+
+Still more or less related:
+
+Say this otherMain function existed, that allowed me to
+to do my own command line parsing and just
+call propellor on some host with the one or the other task,
+I am not 100% what's the right
+way to ensure/require/execute such a task on a host:
+
+above I am just using
+
+```
+ host & property
+```
+
+(from PropAccum), but maybe ensureProperty is better suited
+for that?
+
+Also for the wish list: some CONFIG_FILE env variable that
+would allow me to keep my config.hs somewhere other than
+in ~/.propellor/config.hs
+
+
+Anyway, thanks so far
+I would certainly want to switch to propellor completely.
+
+ Andreas
diff --git a/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_1_8959a79735aa3fa13ee37e57eb5a92e1._comment b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_1_8959a79735aa3fa13ee37e57eb5a92e1._comment
new file mode 100644
index 00000000..273dc758
--- /dev/null
+++ b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_1_8959a79735aa3fa13ee37e57eb5a92e1._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-04-14T18:48:23Z"
+ content="""
+By composing these things at the command-line, you're using the
+command-line, rather than haskell, for describing your system. I don't
+think that's a win.
+
+As far as properties that you don't want to have run every time, see
+`Propellor.Property.Scheduled.period`. For example:
+
+ & Apt.update `period` Daily
+"""]]
diff --git a/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_2_f07c33b4a14cdc0b78695de49875c9b5._comment b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_2_f07c33b4a14cdc0b78695de49875c9b5._comment
new file mode 100644
index 00000000..3eca3457
--- /dev/null
+++ b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_2_f07c33b4a14cdc0b78695de49875c9b5._comment
@@ -0,0 +1,52 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawm-czsfuWENKQ0GI8l0gnGTeF1JEli1mA0"
+ nickname="Andreas"
+ subject="comment 2"
+ date="2015-04-14T19:24:46Z"
+ content="""
+using the command line: well yes, that's right.
+Still: I can configure a lot of details in haskell (ansible playbooks):
+
+my emacs task eg. is not only ensuring that emacs is installed
+(as in the example above), but I also set some links to my
+elisp config files, ensure that cask installed etc.
+
+another task for me is installing X windows:
+again lots of details: not only the xorg packages,
+but some links to .xsession files, window manager config
+files etc.
+
+and yes: I am happy, that I can spell out the details
+of these tasks in propellor/haskell.
+
+I just don't see the point of ensuring them again and again
+with every spin of propellor, and I would want
+to be able to run just this one task on the command line.
+
+
+concerning
+```
+ Apt.update `period` Daily
+```
+thanks, will have a look.
+but I guess this is cron job (will see),
+in general I think I will want to stick to my habit, that I want
+to see what's going on (what is upgraded), thus prefer
+to not run any cron jobs for apt upgrades
+
+My overall message / concern is: I don't want to completly change my
+habits, just because I am using propellor
+
+I had the habit of installing my computers task by task
+
+I had the habit of logging in to one of my systems, and
+doing apt-get update && apt-get upgrade
+
+I want my config tool to help me achieve things in my
+way that I am used to.
+
+
+
+
+
+"""]]
diff --git a/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_3_06c63446531f56e4c93f64f6bcfba2b1._comment b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_3_06c63446531f56e4c93f64f6bcfba2b1._comment
new file mode 100644
index 00000000..144915df
--- /dev/null
+++ b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_3_06c63446531f56e4c93f64f6bcfba2b1._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-04-14T19:42:22Z"
+ content="""
+[period](http://hackage.haskell.org/package/propellor-2.2.1/docs/Propellor-Property-Scheduled.html)
+is not a cron job, it just modifies the Property to only do anything
+every so often.
+
+It's also possible to modify a Property so it only runs once.
+[flagFile](http://hackage.haskell.org/package/propellor-2.2.1/docs/Propellor-Property.html#v:flagFile)
+can be used to do that.
+
+But there are good reasons for propellor to default to checking all
+Properties of a system each time:
+
+* It means that most Properties are idempotent, which has many good
+ features, like being able to recover from a crash.
+* If a system no longer has a configured Property, to fix it back to having
+ the property it's supposed to have.
+* Or, if it can't be fixed, to tell you with an error message in red.
+* It keeps propellor mostly stateless; rather than having to record state
+ about how it thinks a system is, which could diverge from reality,
+ it just looks at how it actually is.
+"""]]
diff --git a/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_4_f52f30380b4fe58292fcf0ef368efbb1._comment b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_4_f52f30380b4fe58292fcf0ef368efbb1._comment
new file mode 100644
index 00000000..ecd20630
--- /dev/null
+++ b/doc/forum/my_experience_with_propellor:_how_to_run_a_single_task_on_a_host__63__/comment_4_f52f30380b4fe58292fcf0ef368efbb1._comment
@@ -0,0 +1,44 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawm-czsfuWENKQ0GI8l0gnGTeF1JEli1mA0"
+ nickname="Andreas"
+ subject="comment 4"
+ date="2015-04-15T10:15:17Z"
+ content="""
+Well thanks a lot, and yes I am learning: propellor has a lot
+of powerful features under the hood already.
+
+I still remain sceptical for the time being:
+
+Propellor's overall approach seems: one spin of propellor does ensure
+that a complete systems is properly installed (and then one can
+declare exceptions: don't check this every time...). I can even see
+how this is useful: if I where a sys admin with a huge farm of
+systems, I wouldn't want to deal with half installed systems, but just
+have propellor do a complete job.
+
+As far as I am only concerned with a few personal computers of mine, I
+prefer to stick to my task by task approach, though, and for tasks
+that come up reapeatedly (like keeping my apt cache + installed
+packages up to date) that seems reasonable to me as well. - having
+only a minimal required configuration for a host, and then building
+upon that (I think/hope, you got the idea by now). The fact, that
+this model is nicely supported by ansible, seems to suggest at least,
+that this kind of reasoning/approach is not completely flawed.
+
+What is not 100% clear to me: if propellor could be bent to support my
+kind of workflow: I would think that it's possible? (even though I
+might not have the time to bend it that way myself). Or are there any
+fundamental issues with it?
+
+What I am suggesting is: that propellor be at my disposal,
+more as a library, and would not also impose a certain
+command line interface / workflow on me.
+
+Anyway, you would certainly win me as a user (don't know
+how much that counts, and cannot speak for other people's
+needs).
+
+Thanks anyway.
+ Andreas
+
+"""]]
diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount.mdwn b/doc/forum/newbie_trying_to_set_up_NFS_mount.mdwn
new file mode 100644
index 00000000..9a2cc33e
--- /dev/null
+++ b/doc/forum/newbie_trying_to_set_up_NFS_mount.mdwn
@@ -0,0 +1,19 @@
+I am checking out propellor to determine if it can make it easier to maintain a few personal machines. With no prior knowledge of Haskell, that may be a futile attempt.
+
+I am trying to understand [the Propellor.Property.Mount documentation](http://hackage.haskell.org/package/propellor-2.17.2/docs/Propellor-Property-Mount.html) and particularly how I would need to write the equivalent of
+
+ mount -t nfs 192.168.1.100:/mnt/usb1 /mnt/nfs
+
+I tried putting
+
+ & Mount.mounted
+ "nfs" "192.168.1.100:/mnt/usb1" "/mnt/nfs" ["defaults"]
+
+in config.hs, but that results in
+
+ Couldn't match expected type ‘Mount.MountOpts’
+ with actual type ‘\[[Char]]’
+ In the fourth argument of ‘Mount.mounted’, namely ‘["defaults"]’
+ In the second argument of ‘(&)’, namely
+ ‘Mount.mounted
+ "nfs" "192.168.1.100:/mnt/usb1" "/mnt/nfs" ["defaults"]’
diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_1_8524e66ddfa2d21ae7b70f257984fc2c._comment b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_1_8524e66ddfa2d21ae7b70f257984fc2c._comment
new file mode 100644
index 00000000..0a4367d9
--- /dev/null
+++ b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_1_8524e66ddfa2d21ae7b70f257984fc2c._comment
@@ -0,0 +1,30 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-04-05T14:53:53Z"
+ content="""
+The easy way to translate your command to a property is:
+
+ cmdProperty "mount" ["-t", "nfs", "192.168.1.100:/mnt/usb1", "/mnt/nfs"]
+ `assume` MadeChange
+
+This has the benefit of working with any command you might want,
+and the drawback of not preventing eg, re-mounting an already
+mounted device.
+
+`mounted` takes a `MountOpts` which is a specialized data type.
+You can construct one with eg, `(MountOpts ["defaults"])`.
+
+But, since `MountOpts` is a `Monoid`, and "defaults" is the default of an
+empty `MountOpts`, you can more simply use `mempty` to get the default one:
+
+ Mount.mounted "nfs" "192.168.1.100:/mnt/usb1" "/mnt/nfs" mempty
+
+Propellor.Property.Mount was mostly written for use by some other
+properties, and so doesn't really target the end user as much. And, I
+notice, its `mounted` property doesn't check if the device is already
+mounted and so will try to re-mount unnecessarily.
+
+I'm not sure if manually driving the mount command makes the most sense;
+wouldn't it be better to have a property that updates /etc/fstab?
+"""]]
diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_2_90831d9859cfe0c6dafe029584b3deef._comment b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_2_90831d9859cfe0c6dafe029584b3deef._comment
new file mode 100644
index 00000000..b21a6973
--- /dev/null
+++ b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_2_90831d9859cfe0c6dafe029584b3deef._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2016-04-06T12:17:09Z"
+ content="""
+I agreed with you joey, we need to be able to add mount point directly into the fstab file in order to let the world know about all the mount points.
+Maybe a way also to generate the mount point with the system d syntax.
+
+So maybe the best solution is to have a DSL (like you did in you dism system) and then generators for fstab, systemd, etc...
+This property should be revertable in order to add or remove lines (files).
+
+the fstab should also contain some invariant code (the lines generated during the system installation). I speak about Debian installation.
+
+Cheers
+
+Fred
+"""]]
diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_3_a82855697a268a4f2165db717a652516._comment b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_3_a82855697a268a4f2165db717a652516._comment
new file mode 100644
index 00000000..f2274c05
--- /dev/null
+++ b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_3_a82855697a268a4f2165db717a652516._comment
@@ -0,0 +1,28 @@
+[[!comment format=mdwn
+ username="frederik@ffbea6a549cb3f460d110386c0f634c1ddc6a68a"
+ nickname="frederik"
+ subject="comment 3"
+ date="2016-04-06T14:14:23Z"
+ content="""
+I tried adding
+
+ & File.dirExists \"/mnt/nfs\"
+ & \"/etc/fstab\" `File.containsLine` \"192.168.1.100:/mnt/usb1 /mnt/nfs nfs intr 0 0\"
+ `onChange` cmdProperty \"mount\" [\"-a\"]
+
+This mimicks the bitlbee example on /usr/local/propellor/config-joey.hs
+
+But that results:
+
+ src/config.hs:36:11:
+ No instance for (Combines
+ (Property NoInfo) (UncheckedProperty NoInfo))
+ arising from a use of ‘onChange’
+ In the second argument of ‘(&)’, namely
+ ‘\"/etc/fstab\"
+ `File.containsLine` \"192.168.1.100:/mnt/usb1 /mnt/nfs nfs intr 0 0\"
+ `onChange` cmdProperty \"mount\" [\"-a\"]’
+
+
+
+"""]]
diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment
new file mode 100644
index 00000000..74c959e8
--- /dev/null
+++ b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-04-07T04:21:39Z"
+ content="""
+That's quite a nice elegant solution, Frederik!
+
+It'll work if you use
+
+ `onChange` (cmdProperty "mount" ["-a"] `assume` MadeChange)
+
+This is ncessary because propellor doesn't know if `cmdProperty`
+makes a change or not. In this case we can just assume it did.
+
+I've added a `Propellor.Property.Fstab.mounted` this evening
+that is essentially Frederik's solution.
+"""]]
diff --git a/doc/forum/parsing_a_config_file.mdwn b/doc/forum/parsing_a_config_file.mdwn
new file mode 100644
index 00000000..cbf0952a
--- /dev/null
+++ b/doc/forum/parsing_a_config_file.mdwn
@@ -0,0 +1,11 @@
+I have an issue with how parsing a tor config file. Hidden services are defined like this: first you specify a dir with "HiddenServiceDir" and then, (on the following lines) you define the port mappings with one or more "HiddenServicePort". You can have multiple hidden services defined in the same tor config file.
+
+ HiddenServiceDir /var/lib/tor/myhttponion
+ HiddenServicePort 80 127.0.0.1:80
+ HiddenServicePort 8080 127.0.0.1:8080
+ HiddenServiceDir /var/lib/tor/myirconion
+ HiddenServicePort 6667 127.0.0.1:6667
+
+I used "configured" to define "hiddenService" in "Propellor.Property.Tor", but I didn't realized that there can be multiple hidden services, each with multiple ports. So, defining multiple hiddenService properties does not work as expected ("Propellor.Property.Tor.configured" assumes there is only one line for one config variable)...
+
+A kind of general file parsing functions on multilines (based on AST?) may be a nice addition to Propellor.Property.File, but it sounds too hard for my skills :-). Maybe someone would have an idea to solve this problem?
diff --git a/doc/forum/parsing_a_config_file/comment_1_8e97fb2e39c1a91bcab75e57ddc8b519._comment b/doc/forum/parsing_a_config_file/comment_1_8e97fb2e39c1a91bcab75e57ddc8b519._comment
new file mode 100644
index 00000000..fa9d74ff
--- /dev/null
+++ b/doc/forum/parsing_a_config_file/comment_1_8e97fb2e39c1a91bcab75e57ddc8b519._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-08-03T19:14:00Z"
+ content="""
+This probably needs a smarter parser for torrc files that understands
+the method that tor uses to decide which config lines go together.
+
+Or, perhaps, a way to add additional torrc files that are included into the
+main one or that tor is otherwise configured to use, which would avoid the
+parsing complexity.
+"""]]
diff --git a/doc/forum/parsing_a_config_file/comment_2_9b364647b1da4c8db0116115e5c67b18._comment b/doc/forum/parsing_a_config_file/comment_2_9b364647b1da4c8db0116115e5c67b18._comment
new file mode 100644
index 00000000..4ceec2f4
--- /dev/null
+++ b/doc/forum/parsing_a_config_file/comment_2_9b364647b1da4c8db0116115e5c67b18._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-08-20T14:43:02Z"
+ content="""
+Sean and I have implemented a somewhat generic support for files with some
+kinds of sections, in Propellor.Property.ConfFile.
+
+I think it could be used for this tor case, by making the SectionStart
+match the HiddenServiceDir line, and the SectionPast match any line that's
+not HiddenServicePort (or perhaps match the next HiddenServiceDir
+line?)
+"""]]
diff --git a/doc/forum/parsing_a_config_file/comment_3_e143e0ebfb1fb631639b692df67ea8e8._comment b/doc/forum/parsing_a_config_file/comment_3_e143e0ebfb1fb631639b692df67ea8e8._comment
new file mode 100644
index 00000000..5d653a97
--- /dev/null
+++ b/doc/forum/parsing_a_config_file/comment_3_e143e0ebfb1fb631639b692df67ea8e8._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-08-25T18:55:55Z"
+ content="""
+The Tor hiddenservice property has been updated to use this config file
+parser, so multiple services can be defined.
+"""]]
diff --git a/doc/forum/passing_host_address_dynamically_to_propellor.mdwn b/doc/forum/passing_host_address_dynamically_to_propellor.mdwn
new file mode 100644
index 00000000..1d6bc0be
--- /dev/null
+++ b/doc/forum/passing_host_address_dynamically_to_propellor.mdwn
@@ -0,0 +1,2 @@
+I would like to be able to pass the address of a host dynamically to propellor, e.g. to do something like `./propellor 1.2.3.4` so that I can apply some predefined set of properties.
+I tried to implement, it compiles just fine, but does fail to run properly on the remote (or even local) host because `defaultMain` does some transformation of command-line and of course the host name/address does not exist statically in the git repo that's built and run on the remote host. Would there be another way to do what I want?
diff --git a/doc/forum/passing_host_address_dynamically_to_propellor/comment_1_1c5d5b59f2325a2f4e06d09a9900007f._comment b/doc/forum/passing_host_address_dynamically_to_propellor/comment_1_1c5d5b59f2325a2f4e06d09a9900007f._comment
new file mode 100644
index 00000000..57b2a63b
--- /dev/null
+++ b/doc/forum/passing_host_address_dynamically_to_propellor/comment_1_1c5d5b59f2325a2f4e06d09a9900007f._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-05-29T14:05:10Z"
+ content="""
+What's the use case here?
+
+I think maybe you're trying to deploy basically the same set of properties
+to multiple hosts. And perhaps don't want to have the list of hosts in the
+config.hs file. If that's the goal, it seems you could accomplish it by
+writing a function like:
+
+ stdHost :: IPAddr -> Host
+
+Or more generally,
+
+ stdHost :: Property HasInfo -> Host
+
+And then you can map over the set of IP addresses to generate the the
+[Host] list for propellor. Or could even read a data file (that would need
+to be checked into the git repo) and use it to constuct the [Host] list at
+runtime.
+
+But maybe I misunderstood the use case..
+"""]]
diff --git a/doc/forum/passing_host_address_dynamically_to_propellor/comment_2_b9041877dfc6e6bfb63a014492a2d1d1._comment b/doc/forum/passing_host_address_dynamically_to_propellor/comment_2_b9041877dfc6e6bfb63a014492a2d1d1._comment
new file mode 100644
index 00000000..0f59b424
--- /dev/null
+++ b/doc/forum/passing_host_address_dynamically_to_propellor/comment_2_b9041877dfc6e6bfb63a014492a2d1d1._comment
@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="arnaud.oqube@c9b8c7ea33f1dea0b7a5485b86825c5bfa9efbf7"
+ nickname="arnaud.oqube"
+ subject="comment 2"
+ date="2015-05-29T15:09:24Z"
+ content="""
+We create/destroy dynamically hosts which have different purpose: CI, Dev boxes, Testing... IP of these hosts is unknown and assign by our provider (Digital Ocean) so what I would like to do is something like:
+
+```
+$ create-host
+...
+IP: 1.2.3.4
+$ ./propellor 1.2.3.4
+```
+
+But indeed the idea of having a local `hosts` file makes sense, or even a `hosts/` directory to which I output files containing IPs.
+
+"""]]
diff --git a/doc/forum/passing_host_address_dynamically_to_propellor/comment_3_49d6408ee7618ccb88a537e519f95b27._comment b/doc/forum/passing_host_address_dynamically_to_propellor/comment_3_49d6408ee7618ccb88a537e519f95b27._comment
new file mode 100644
index 00000000..37962eff
--- /dev/null
+++ b/doc/forum/passing_host_address_dynamically_to_propellor/comment_3_49d6408ee7618ccb88a537e519f95b27._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-05-30T14:50:14Z"
+ content="""
+Or teach propellor --spin how to create Digital Ocean, AWS, etc VMs, as
+described in [[todo/HostingProvider_for_AWS]].
+
+I guess that even if it created the hosts, it would make sense to have a
+static host list with their IPs.
+"""]]
diff --git a/doc/forum/passing_host_address_dynamically_to_propellor/comment_4_1f208acbe17e25a2b25e1615146d7a0a._comment b/doc/forum/passing_host_address_dynamically_to_propellor/comment_4_1f208acbe17e25a2b25e1615146d7a0a._comment
new file mode 100644
index 00000000..45d24f0e
--- /dev/null
+++ b/doc/forum/passing_host_address_dynamically_to_propellor/comment_4_1f208acbe17e25a2b25e1615146d7a0a._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="arnaud.oqube@c9b8c7ea33f1dea0b7a5485b86825c5bfa9efbf7"
+ nickname="arnaud.oqube"
+ subject="comment 4"
+ date="2015-05-31T20:18:30Z"
+ content="""
+That makes sense. Indeed, that's the direction I was heading to, because currently our VM deployment scripts are in shell and I wanted to port them to Haskell and integrate in the provisioning process.
+Thanks for the idea, I will see where it goes.
+"""]]
diff --git a/doc/forum/passing_host_address_dynamically_to_propellor/comment_5_cd61e6fb0d5694575edb95728f0c8370._comment b/doc/forum/passing_host_address_dynamically_to_propellor/comment_5_cd61e6fb0d5694575edb95728f0c8370._comment
new file mode 100644
index 00000000..79f721f1
--- /dev/null
+++ b/doc/forum/passing_host_address_dynamically_to_propellor/comment_5_cd61e6fb0d5694575edb95728f0c8370._comment
@@ -0,0 +1,23 @@
+[[!comment format=mdwn
+ username="arnaud@30aba4d9f1742050874551d3ddc55ca8694809f8"
+ nickname="arnaud"
+ subject="Works like a charm..."
+ date="2015-06-11T19:19:07Z"
+ content="""
+I implemented this feature using a file, aptly named `hosts` that is versioned in the repo and populated (at the moment manually but will be automatic...) when boxes are created in DO.
+Then the following main will extract the information and create hosts config to be passed to main from propellor, reading the needed file:
+
+```
+main :: IO ()
+main = do
+ h <- map words <$> lines <$> readFile \"hosts\" `catch` (\ (_ :: IOException) -> return \"\")
+ let hosts = map selectHost h
+ defaultMain hosts
+
+selectHost :: [String] -> Host
+selectHost [\"prod\",ip,sha1] = host ip & Lending.lendingHost sha1
+selectHost [\"prod\",ip] = host ip & Lending.lendingHost currentSha1
+selectHost [\"monitor\",name,ip] = host name & Monitoring.monitoringHost ip
+selectHost h = error $ \"doesn't know how to handle host definition \" ++ show h
+```
+"""]]
diff --git a/doc/forum/problem_with_Tar.mdwn b/doc/forum/problem_with_Tar.mdwn
new file mode 100644
index 00000000..b793559e
--- /dev/null
+++ b/doc/forum/problem_with_Tar.mdwn
@@ -0,0 +1,12 @@
+Hello, I am trying to use the Tar property but I get this message
+
+ Preprocessing executable 'propellor-config' for propellor-2.12.0...
+ [66 of 68] Compiling Propellor.Property.Tar ( src/Propellor/Property/Tar.hs, dist/build/propellor-config/propellor-config-tmp/Propellor/Property/Tar.o ) [Propellor changed]
+
+ src/Propellor/Property/Tar.hs:12:7: Not in scope: `liftIO'
+
+ src/Propellor/Property/Tar.hs:12:25:
+ Not in scope: `<$>'
+ Perhaps you meant one of these:
+ `<!>' (imported from Propellor), `<>' (imported from Propellor)
+ propellor: cabal build failed
diff --git a/doc/forum/problem_with_Tar/comment_1_605863f2846dd2e2ccf2516ad54042fb._comment b/doc/forum/problem_with_Tar/comment_1_605863f2846dd2e2ccf2516ad54042fb._comment
new file mode 100644
index 00000000..ce0f776e
--- /dev/null
+++ b/doc/forum/problem_with_Tar/comment_1_605863f2846dd2e2ccf2516ad54042fb._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 1"
+ date="2015-10-27T11:04:52Z"
+ content="""
+Adding only
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Applicative ((<$>))
+
+solve the problem, but I do not know how you want to solve this problem :)
+"""]]
diff --git a/doc/forum/problem_with_Tar/comment_2_c3a5801b7a22b3b52ed1d2279e725739._comment b/doc/forum/problem_with_Tar/comment_2_c3a5801b7a22b3b52ed1d2279e725739._comment
new file mode 100644
index 00000000..7d02a6d6
--- /dev/null
+++ b/doc/forum/problem_with_Tar/comment_2_c3a5801b7a22b3b52ed1d2279e725739._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-10-27T16:54:23Z"
+ content="""
+This module has not been submitted or merged into mainline propellor,
+at least not yet, so I guess you can solve build problems with it however
+you like. ;-)
+"""]]
diff --git a/doc/forum/propellor_--add-key_fails.mdwn b/doc/forum/propellor_--add-key_fails.mdwn
new file mode 100644
index 00000000..8b42cc5a
--- /dev/null
+++ b/doc/forum/propellor_--add-key_fails.mdwn
@@ -0,0 +1,64 @@
+Hi,
+
+When following the instructions on the web site, I get the following error in step 4:
+
+```
+olpe4718@admin:~$ propellor --add-key CD9BFD10
+Building propellor-2.8.0...
+Preprocessing library propellor-2.8.0...
+In-place registering propellor-2.8.0...
+Preprocessing executable 'propellor' for propellor-2.8.0...
+Preprocessing executable 'propellor-config' for propellor-2.8.0...
+Propellor build ... done
+
+
+gpg: privdata/keyring.gpg: nyckelring skapad
+gpg: nyckel CD9BFD10: publika nyckeln "Per Olofsson (DSV) <pelle@dsv.su.se>" importerades
+gpg: Totalt antal behandlade enheter: 1
+gpg: importerade: 1 (RSA: 1)
+adding key to propellor's keyring ... done
+staging propellor's keyring ... done
+updating encryption of any privdata ... done
+configuring git commit signing to use key ... done
+error: pathspec 'privdata/privdata.gpg' did not match any file(s) known to git.
+committing changes ... failed
+```
+
+Simply running `git commit -S` afterwards seems to work though.
+
+Debug mode output:
+
+```
+olpe4718@admin:~$ PROPELLOR_DEBUG=1 propellor --add-key CD9BFD10
+Building propellor-2.8.0...
+Preprocessing library propellor-2.8.0...
+In-place registering propellor-2.8.0...
+Preprocessing executable 'propellor' for propellor-2.8.0...
+Preprocessing executable 'propellor-config' for propellor-2.8.0...
+Propellor build ... done
+
+
+[2015-10-04 10:55:50 CEST] command line: AddKey "CD9BFD10"
+[2015-10-04 10:55:50 CEST] call: sh ["-c","gpg --export CD9BFD10 | gpg --options /dev/null --no-default-keyring --keyring privdata/keyring.gpg --import"]
+gpg: privdata/keyring.gpg: nyckelring skapad
+gpg: nyckel CD9BFD10: publika nyckeln "Per Olofsson (DSV) <pelle@dsv.su.se>" importerades
+gpg: Totalt antal behandlade enheter: 1
+gpg: importerade: 1 (RSA: 1)
+[2015-10-04 10:55:50 CEST] process done ExitSuccess
+adding key to propellor's keyring ... done
+[2015-10-04 10:55:50 CEST] call: git ["add","privdata/keyring.gpg"]
+[2015-10-04 10:55:50 CEST] process done ExitSuccess
+staging propellor's keyring ... done
+updating encryption of any privdata ... done
+[2015-10-04 10:55:50 CEST] read: gpg ["--list-secret-keys","CD9BFD10"]
+[2015-10-04 10:55:50 CEST] process done ExitSuccess
+[2015-10-04 10:55:50 CEST] call: git ["config","user.signingkey","CD9BFD10"]
+[2015-10-04 10:55:50 CEST] process done ExitSuccess
+configuring git commit signing to use key ... done
+[2015-10-04 10:55:50 CEST] call: git ["commit","privdata/keyring.gpg","privdata/privdata.gpg","-m","propellor add-key","--gpg-sign"]
+error: pathspec 'privdata/privdata.gpg' did not match any file(s) known to git.
+[2015-10-04 10:55:50 CEST] process done ExitFailure 1
+committing changes ... failed
+```
+
+Seems that it tries to check in privdata.gpg which does not exist yet.
diff --git a/doc/forum/propellor_--add-key_fails/comment_1_573d07e2387b342a2029c9fc51869040._comment b/doc/forum/propellor_--add-key_fails/comment_1_573d07e2387b342a2029c9fc51869040._comment
new file mode 100644
index 00000000..28db61d8
--- /dev/null
+++ b/doc/forum/propellor_--add-key_fails/comment_1_573d07e2387b342a2029c9fc51869040._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-04T17:51:15Z"
+ content="""
+Your workaround is ok. It tried to commit the privdata.gpg file
+even though you have not set any privdata yet. I've fixed this in git.
+"""]]
diff --git a/doc/forum/propellor_2.15.2_does_not_work_on_jessie.mdwn b/doc/forum/propellor_2.15.2_does_not_work_on_jessie.mdwn
new file mode 100644
index 00000000..7676a8a3
--- /dev/null
+++ b/doc/forum/propellor_2.15.2_does_not_work_on_jessie.mdwn
@@ -0,0 +1,20 @@
+Hello, I am trying to use propellor 2.15.2 on jessie.
+
+but when I do
+
+runhaskell config.hs, I get this error message
+
+
+ Propellor/Git.hs:10:9 Not in scope: `<$>'
+
+ Propellor/Git.hs:14:9 Not in scope: `<$>'
+
+ Propellor/Git.hs:18:9 Not in scope: `<$>'
+
+ Propellor/Git.hs:22:21 Not in scope: `<$>'
+
+maybe an import is missing with ghc 7.6.3
+
+Cheers
+
+Frederic
diff --git a/doc/forum/propellor_2.15.2_does_not_work_on_jessie/comment_1_eafe3affdad32bc9f4493a938f71d83f._comment b/doc/forum/propellor_2.15.2_does_not_work_on_jessie/comment_1_eafe3affdad32bc9f4493a938f71d83f._comment
new file mode 100644
index 00000000..f3af56ee
--- /dev/null
+++ b/doc/forum/propellor_2.15.2_does_not_work_on_jessie/comment_1_eafe3affdad32bc9f4493a938f71d83f._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-01-12T16:39:26Z"
+ content="""
+Yes, unfortuntely by importing Control.Applicative by default, newer
+versions of ghc make it rather harder to produce code that will build on
+older versions too. I've added these imports.
+"""]]
diff --git a/doc/forum/propellor_with_no_central_repository__63__/comment_2_0f035bb4bb5cc13574394505f28abe5e._comment b/doc/forum/propellor_with_no_central_repository__63__/comment_2_0f035bb4bb5cc13574394505f28abe5e._comment
new file mode 100644
index 00000000..6a6aa946
--- /dev/null
+++ b/doc/forum/propellor_with_no_central_repository__63__/comment_2_0f035bb4bb5cc13574394505f28abe5e._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""yay!"""
+ date="2014-11-19T01:31:14Z"
+ content="""
+propellor now supports this mode by default, just use `propellor --spin
+hostname` and the changes in the local repo will be pushed and deployed to
+the host, w/o needing a centralized git repo.
+"""]]
diff --git a/doc/forum/property_combinator_ordering.mdwn b/doc/forum/property_combinator_ordering.mdwn
new file mode 100644
index 00000000..25549bb4
--- /dev/null
+++ b/doc/forum/property_combinator_ordering.mdwn
@@ -0,0 +1,8 @@
+when I write
+
+ setDistribution cfg = f `File.hasContent` cfg
+ `onChange` update
+ `requires` File.dirExists confDir
+
+is update called before ensuring the confiDir Exist ?
+It seems to me but who knows ?
diff --git a/doc/forum/property_combinator_ordering/comment_1_0ea2186b5cfa7eadaf38ac2e97fc4a2c._comment b/doc/forum/property_combinator_ordering/comment_1_0ea2186b5cfa7eadaf38ac2e97fc4a2c._comment
new file mode 100644
index 00000000..c41abd90
--- /dev/null
+++ b/doc/forum/property_combinator_ordering/comment_1_0ea2186b5cfa7eadaf38ac2e97fc4a2c._comment
@@ -0,0 +1,31 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2014-12-01T15:53:11Z"
+ content="""
+I think that should behave intuitively, but of course if you're unsure
+of this kind of thing, adding parens is a good way to disambiguate the
+code.
+
+ (f `File.hasContent` cfg `onChange` update)
+ `requires` File.dirExists confDir
+
+Written that way, it's explicit that the parenthesized part runs
+together as one action.
+
+Or, we can do a quick test in ghci:
+
+ joey@darkstar:~/src/propellor/src#joeyconfig>ghci Propellor.hs Propellor/Property.hs
+ *Propellor> let f1 = property "hasContent" (liftIO (print "f1") >> return MadeChange)
+ *Propellor> let f2 = property "update" (liftIO (print "f2") >> return MadeChange)
+ *Propellor> let f3 = property "dirExists" (liftIO (print "f3") >> return MadeChange)
+ *Propellor> runPropellor (Host "foo" [] mempty) $ ensureProperty $ f1 `onChange` f2 `requires` f3
+ "dirExists"
+ "hasContent"
+ "update"
+ MadeChange
+
+So, yes, it's behaving as it should, first ensuring that the `requires`
+property is met, and then running the main property, and since it made a
+change, following up by running the `onChange` property.
+"""]]
diff --git a/doc/forum/property_which_create_a_file.mdwn b/doc/forum/property_which_create_a_file.mdwn
new file mode 100644
index 00000000..a5124a1b
--- /dev/null
+++ b/doc/forum/property_which_create_a_file.mdwn
@@ -0,0 +1,15 @@
+Hello, I promize you another question related to my sbuild property :)
+
+So this property generate at the end a chroot in a file
+
+ /var/lib/sbuild/jessie-i386.tar.gz
+
+Since this process take a lot's of time, I do not want to run this process each time.
+I would like to process this property only if the file does not exists.
+
+
+I found the flagFile property but I do not think that it is the right answer to my problem.
+
+I just want to express that a file is the result of a property and no need to re-run the proerty if this file exists.
+
+Cheers
diff --git a/doc/forum/property_which_create_a_file/comment_1_bc541cd7e3fdaa8e1664e95bebecb2bc._comment b/doc/forum/property_which_create_a_file/comment_1_bc541cd7e3fdaa8e1664e95bebecb2bc._comment
new file mode 100644
index 00000000..cb8bd32f
--- /dev/null
+++ b/doc/forum/property_which_create_a_file/comment_1_bc541cd7e3fdaa8e1664e95bebecb2bc._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-09-30T14:53:02Z"
+ content="""
+My suggestion in the specific case of the sbuild property would be to
+generate the file whenever the property that generates the chroot has to
+make a change. The `onChange` combinator accomplishes that.
+
+But if you really want to only run the property if the file doesn't exist,
+you can do that by using the `check` combinator. For example:
+
+ check (not <$> doesFileExist f) (createtarball f)
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs.mdwn b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs.mdwn
new file mode 100644
index 00000000..3dc6c7c8
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs.mdwn
@@ -0,0 +1,6 @@
+With recent snapshots of propellor (after at least March 11) I am seeing significant increases of memory consumed by ghc when compiling propellor. Previous versions would compile and run on e.g. a raspberry pi. With a recent snapshot, I am seeing ghc OOM with a 5GB ulimit on my desktop. Has anybody else seen this?
+
+This is with the same version of GHC.
+
+ % ghc --version
+ The Glorious Glasgow Haskell Compilation System, version 7.10.3
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_10_f64dc6112a27f5f9a0b6ccf379c7a0e2._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_10_f64dc6112a27f5f9a0b6ccf379c7a0e2._comment
new file mode 100644
index 00000000..8067ba99
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_10_f64dc6112a27f5f9a0b6ccf379c7a0e2._comment
@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 10"""
+ date="2016-06-02T22:14:23Z"
+ content="""
+Mistakes in the parameters of properties (leaving out a parameter, wrong type
+parameter, etc) don't cause these super-long error messages, even when the
+property is in the middle of a big block of other properties.
+
+The problem occurs only when a lot of properties have
+been combined together using `&` and used in an ill-typed way; in this situation
+ghc can't infer the a simple type for the combined properties, due to the use
+of type level functions to combine them.
+
+So, at least in this case, it doesn't seem to be a problem users are likely
+to hit except during the propellor 3.0 ugrade or if they forget to use
+`props` at some other time.
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_11_ac0d07af8234d6adb9b40524f6d5b10b._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_11_ac0d07af8234d6adb9b40524f6d5b10b._comment
new file mode 100644
index 00000000..8a1ef763
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_11_ac0d07af8234d6adb9b40524f6d5b10b._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="craige@a46118dff5bc0fad85259759970d8b4b9fc377d7"
+ nickname="craige"
+ subject="Thanks!"
+ date="2016-06-03T00:40:32Z"
+ content="""
+That all makes sense. Thanks joey.
+
+The update to Propellor 3.x caught me by surprise and this all resulted from that. Clearly I need to watch Propellor blog posts more more carefully :-)
+
+I'll take your example, read the upgrading doco and get things going from there, now the I understand the problem.
+
+I'll pass on those modules when the move beyond \"embarrassingly incomplete\" and become something that I think other people can use :-D
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_1_0e46ad1844c37a65c532cafe81fd883a._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_1_0e46ad1844c37a65c532cafe81fd883a._comment
new file mode 100644
index 00000000..be42b0df
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_1_0e46ad1844c37a65c532cafe81fd883a._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-10T16:07:39Z"
+ content="""
+The enhanced property types in propellor 3.0 are known to have made ghc use
+more memory when building it. Building with -O0 helped a lot for me, and
+it's doing ok on a 500 mb memory machine. So I recommend -O0 in your cabal
+file if you don't have that already.
+
+I wrote down my memory benchmarks here:
+<http://source.propellor.branchable.com/?p=source.git;a=commit;h=af7b2d61c0c7f9b4fe53d8f5d18b5426a93cbd7b>
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_2_be69a181c1c5212abdc518881f80a199._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_2_be69a181c1c5212abdc518881f80a199._comment
new file mode 100644
index 00000000..f3325454
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_2_be69a181c1c5212abdc518881f80a199._comment
@@ -0,0 +1,24 @@
+[[!comment format=mdwn
+ username="craige@a46118dff5bc0fad85259759970d8b4b9fc377d7"
+ nickname="craige"
+ subject="-O0"
+ date="2016-05-30T04:41:08Z"
+ content="""
+I'm experiencing this quite badly. GHC will consume all 8G RAM before locking the machine up (if I don't catch it first).
+
+-O0 was already in propellor.cabal:
+
+GHC-Options: -threaded -Wall -fno-warn-tabs -O0
+
+I have set PROPELLOR_DEBUG=1
+
+Strace isn't turning up anything that I can use.
+
+I'm not getting a anything useful to track down the source of this problem for me.
+
+Any tips on what I can do to track this down?
+
+Thanks!
+
+Debian testing || Propeller 3.0.3
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_3_7552ac7f5c97c8c2854305b6f0dd7c6b._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_3_7552ac7f5c97c8c2854305b6f0dd7c6b._comment
new file mode 100644
index 00000000..ff3ed1b3
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_3_7552ac7f5c97c8c2854305b6f0dd7c6b._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-05-30T14:56:57Z"
+ content="""
+If ghc is using 8 gb of memory, that sounds like a ghc bug.
+
+Can you share the source code that causes this behavior?
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_4_2fa7a7b10f3a9d2602607ebb8bb48a65._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_4_2fa7a7b10f3a9d2602607ebb8bb48a65._comment
new file mode 100644
index 00000000..11411ff2
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_4_2fa7a7b10f3a9d2602607ebb8bb48a65._comment
@@ -0,0 +1,38 @@
+[[!comment format=mdwn
+ username="craige@a46118dff5bc0fad85259759970d8b4b9fc377d7"
+ nickname="craige"
+ subject="Source"
+ date="2016-05-31T02:10:53Z"
+ content="""
+Thanks for getting back to me Joey. BTW a friend of mine (Fractalcat | Sharif) met you at ICFP where you claimed I was your fourth user of propellor ;-)
+
+I'm not sure which source you're specifically after and my propellor repo is not yet public. Perhaps now's the time to do that :-)
+
+Here's where it's getting stuck in the propellor --spin cycle, this last one ran for 3 hours consuming most RAM and swap before I killed it:
+
+compile: input file src/config.hs
+*** Checking old interface for Main:
+[89 of 89] Compiling Main ( src/config.hs, dist/build/propellor-config/propellor-config-tmp/Main.o )
+*** Parser:
+*** Renamer/typechecker:
+^C^C^C^C
+
+My GHC flags in propellor.cabal are:
+
+Executable propellor-config
+ Main-Is: config.hs
+ GHC-Options: -threaded -Wall -fno-warn-tabs -O0 -v3 -j1
+ Extensions: TypeOperators
+ Hs-Source-Dirs: src
+ Build-Depends:
+ base >= 4.5, base < 5,
+ MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
+ unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
+ time, mtl, transformers, exceptions (>= 0.6), stm, text
+
+Some googling made me think my custom types were causing this and they needed to be upgraded so I commented out all my custom types but this did not help.
+
+I'm happy to paste up my source when I know which files you need.
+
+Thanks!
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_5_3311b66df8a66f304924b329cc71c59b._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_5_3311b66df8a66f304924b329cc71c59b._comment
new file mode 100644
index 00000000..8a9ed73c
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_5_3311b66df8a66f304924b329cc71c59b._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2016-05-31T16:23:16Z"
+ content="""
+I'm looking for a test case to reproduce the problem. Your config.hs would
+probably do unless it refers to modules that don't ship with propellor.
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_6_b7c19550ce9a5714bf8953a4134838f1._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_6_b7c19550ce9a5714bf8953a4134838f1._comment
new file mode 100644
index 00000000..c8caceb0
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_6_b7c19550ce9a5714bf8953a4134838f1._comment
@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="craige@a46118dff5bc0fad85259759970d8b4b9fc377d7"
+ nickname="craige"
+ subject="Source"
+ date="2016-06-02T04:55:19Z"
+ content="""
+My config.hs is here:
+https://git.mcwhirter.io/snippets/1
+
+I've added my propellor.cabal as there may be value in that:
+https://git.mcwhirter.io/snippets/2
+
+I do have my own modules. Disabling them was one of my first steps. This should now be only using shipped Propellor modules.
+
+I'm interested in seeing your thoughts.
+
+Thanks Joey.
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_7_37a683d847bd7275c6ff7b0ad94af6a6._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_7_37a683d847bd7275c6ff7b0ad94af6a6._comment
new file mode 100644
index 00000000..51b53ba3
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_7_37a683d847bd7275c6ff7b0ad94af6a6._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 7"
+ date="2016-06-02T20:26:40Z"
+ content="""
+I ran into a similar problem, only I had a lot more memory to go through before OOMing (GHC went up to 20 GB). After commenting out part of my configuration, I got a ton of type errors (due to mixing up Property types in a bunch of places, as well as having a missing `props`). Once I fixed the type errors and then uncommenting everything, complication proceeded as normal. So I think there is some pathological case here that causes some blowup in compilation when the types don't line up properly, possible due to some exponential complexity somewhere.
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_8_b20c69390343bf3b2a7f7b6776f43389._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_8_b20c69390343bf3b2a7f7b6776f43389._comment
new file mode 100644
index 00000000..df8c6222
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_8_b20c69390343bf3b2a7f7b6776f43389._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 8"""
+ date="2016-06-02T21:04:33Z"
+ content="""
+@mithrandi there are ways to make ghc type error messages arbitrarily long,
+and IIRC that causes the memory to blow up.
+
+I'm mostly interested in memory blowups when building a valid
+configuration, since those cause problems to the hosts propellor is
+deployed to, rather than just to the system where it's developed.
+"""]]
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_9_2944596b92b437f9c5978cfc1e1bf4fb._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_9_2944596b92b437f9c5978cfc1e1bf4fb._comment
new file mode 100644
index 00000000..3dbbf8e7
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_9_2944596b92b437f9c5978cfc1e1bf4fb._comment
@@ -0,0 +1,71 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 9"""
+ date="2016-06-02T21:07:10Z"
+ content="""
+@craige I do get an OOM with your config.hs.
+
+So, the first thing I tried was to delete several of the
+big blocks of `&` properties to simplify it.
+
+That led to some error messages, which didn't OOM ghc this time,
+but were still several pages long each.
+
+The main problem is that standardDesktop etc functions have not finished
+being ported to propellor 3.0. A minimalized example derived from your config
+is as follows:
+
+ standardDesktop :: HostName -> DebianSuite -> Architecture -> Host
+ standardDesktop hn suite arch motd = host hn
+ & osDebian suite arch
+ & Apt.unattendedUpgrades
+ & Apt.cacheCleaned
+ & Apt.installed ["etckeeper"]
+ -- adding more properties here yields exponentially longer
+ -- type inference errors
+
+That would have worked before propellor 3.0, but I had to remove support
+for adding additional properties into an existing Host using `&` like this.
+Also, in propellor 3.0, you have to use `props` when building a list
+of properties to assign to a host. See [[upgrading_to_propellor_3.0]].
+
+The way I dealt with it in joeyconfig.hs is to make my standardSystem not
+be a function to generate a Host, but just a Property that combines
+together other properties and can be added to a Host like any other
+Property. I suggest you make similar changes to your config.hs to get it
+to compile. The fixed version of the above example becomes:
+
+ standardDesktop :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
+ standardDesktop suite arch = propertyList "standard desktop" $ props
+ & osDebian suite arch
+ & Apt.unattendedUpgrades
+ & Apt.cacheCleaned
+ & Apt.installed ["etckeeper"]
+
+So in summary, in this case, the ghc OOM is due to a type inference
+error message, proabably quite an enourmous one as ghc chews on
+a bunch of properties that are being combined together, and tries to say
+that their type should be Property (HasInfo + Debian) and not Host, but
+says it in the most verbose way imaginable.
+
+(I don't think the type checker is blowing up, because ghc is able to get
+to the point of saying "Couldn't match expected" before it blows up ..
+the type checker has found a problem and the error message is being lazily
+generated.)
+
+It may be that the super-long error message could be improved by
+[[todo/use_ghc_8.0_custom_compile_errors]], although I believe that
+ ghc still displays the full type error message after the custom error
+message.
+
+ghc is printing out each application of the Propellor.Types.MetaTypes.Intersect
+type-level function, along with all its inputs. I wonder if there's a
+way to "force" application of a type-level function so the error message
+only shows its value?
+
+(It certianly seems a bug that ghc can eat all memory to display totally
+enormous type errror messages.)
+
+(Also @craige, you need to submit some of those modules to include in propellor.
+How can propellor be complete w/o MineCraft support?)
+"""]]
diff --git a/doc/forum/reconfigure_package.mdwn b/doc/forum/reconfigure_package.mdwn
new file mode 100644
index 00000000..3278032d
--- /dev/null
+++ b/doc/forum/reconfigure_package.mdwn
@@ -0,0 +1,15 @@
+Hello,it would be nice to have the possibility to reconfigure a package without giving debconf selection
+
+this way it would be possible to just ask for a package reconfiguration.
+
+exemple the libdvd-pkg need to be reconfigure after installtion in order to install the dvdcss part.
+
+will it be possible for you to change the signature of reconfigure
+
+from
+
+reConfigure :: Package -> [(String, String, String)] -> Property NoInfo
+
+to
+
+reConfigure :: Package -> Maybe [(String, String, String)] -> Property NoInfo
diff --git a/doc/forum/reconfigure_package/comment_1_9dc1f678cf2e4d70c218d9220b0ed320._comment b/doc/forum/reconfigure_package/comment_1_9dc1f678cf2e4d70c218d9220b0ed320._comment
new file mode 100644
index 00000000..26e92881
--- /dev/null
+++ b/doc/forum/reconfigure_package/comment_1_9dc1f678cf2e4d70c218d9220b0ed320._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-09-13T16:48:21Z"
+ content="""
+Wouldn't passing an empty list work pretty well?
+
+Of course, cmdProperty could also be used to run whatever command you need.
+"""]]
diff --git a/doc/forum/reconfigure_package/comment_2_840eee135abdf283f788dd7a3615b816._comment b/doc/forum/reconfigure_package/comment_2_840eee135abdf283f788dd7a3615b816._comment
new file mode 100644
index 00000000..0bd4e6d6
--- /dev/null
+++ b/doc/forum/reconfigure_package/comment_2_840eee135abdf283f788dd7a3615b816._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 2"
+ date="2015-09-13T17:36:47Z"
+ content="""
+you are right I did not test with an empty list...
+
+and for now I already extract the reconfigure part and created my one property.
+
+I do not know it is it better to put Nothing or [] to express an empty debconf selection.
+"""]]
diff --git a/doc/forum/reconfigure_package/comment_3_0d739809f8eeefa1c22f96a7c2d3a522._comment b/doc/forum/reconfigure_package/comment_3_0d739809f8eeefa1c22f96a7c2d3a522._comment
new file mode 100644
index 00000000..46aff956
--- /dev/null
+++ b/doc/forum/reconfigure_package/comment_3_0d739809f8eeefa1c22f96a7c2d3a522._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 3"
+ date="2015-09-13T18:08:56Z"
+ content="""
+Yes it works with an empty list :)
+
+sorry for the noise and thanks
+"""]]
diff --git a/doc/forum/removing_key.mdwn b/doc/forum/removing_key.mdwn
new file mode 100644
index 00000000..2d269170
--- /dev/null
+++ b/doc/forum/removing_key.mdwn
@@ -0,0 +1 @@
+How can I remove a key from the set of keys allowed for encryption of private data?
diff --git a/doc/forum/removing_key/comment_1_d3771b025fa844c5b6d99d54dd9a2524._comment b/doc/forum/removing_key/comment_1_d3771b025fa844c5b6d99d54dd9a2524._comment
new file mode 100644
index 00000000..157f2562
--- /dev/null
+++ b/doc/forum/removing_key/comment_1_d3771b025fa844c5b6d99d54dd9a2524._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-09-23T18:27:03Z"
+ content="""
+The file privdata/keyring.gpg is where propellor keeps the public
+keys it uses to sign the privdata. This is a regular gpg keyring, so can
+be manipulated by regular gpg commands.
+
+I also just added propellor --rm-key to make it easy to remove a key.
+"""]]
diff --git a/doc/forum/removing_key/comment_2_81dfe67885ff21c43894662933e7be7d._comment b/doc/forum/removing_key/comment_2_81dfe67885ff21c43894662933e7be7d._comment
new file mode 100644
index 00000000..14f1e60a
--- /dev/null
+++ b/doc/forum/removing_key/comment_2_81dfe67885ff21c43894662933e7be7d._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="arnaud@30aba4d9f1742050874551d3ddc55ca8694809f8"
+ nickname="arnaud"
+ subject="comment 2"
+ date="2015-09-29T10:01:33Z"
+ content="""
+Great, thanks a lot for that.
+"""]]
diff --git a/doc/forum/running_propellor_as_a_library.mdwn b/doc/forum/running_propellor_as_a_library.mdwn
new file mode 100644
index 00000000..a6945308
--- /dev/null
+++ b/doc/forum/running_propellor_as_a_library.mdwn
@@ -0,0 +1,4 @@
+I would like to define my propellor configuration using propellor as a library dependency, which removes the need to fork source repo, merge...
+I encounter an issue when trying to use propellor in that way: Everything under `Utility/` is not exported by the propellor, so cannot be used from my own properties. This is annoying because there are interesting things to build properties, like running processes...
+
+Would you consider exposing those modules, maybe through some other module like `Propellor.Utility` ?
diff --git a/doc/forum/running_propellor_as_a_library/comment_1_a7b8279508cd68e8cfbba238178a7643._comment b/doc/forum/running_propellor_as_a_library/comment_1_a7b8279508cd68e8cfbba238178a7643._comment
new file mode 100644
index 00000000..10188525
--- /dev/null
+++ b/doc/forum/running_propellor_as_a_library/comment_1_a7b8279508cd68e8cfbba238178a7643._comment
@@ -0,0 +1,49 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-05-27T15:24:07Z"
+ content="""
+The Utility.* modules are shared amoung several of my projects (git-annex,
+propeller, github-backup, ..), but I'm not really happy enough with them to
+make them a proper haskell library.
+
+For one thing, there's no unifying principle; it's just whatever bits of
+code I happened to write that were refactorable out of the main program. I
+don't want to end up with another MissingH like tarball library here.
+
+And for another thing, I don't think I want to commit to api stability, or
+even api versioning for all of that stuff.
+
+Some parts of it, I'm somewhat happier with, and hope to eventually break
+out into proper haskell libraries. For example, Utility.Scheduled is pretty
+good (and mostly re-exported from Propellor.Property.Scheduled anyway).
+
+OTOH, Utility.Process .. not happy with that at all from a design POV.
+I'd recommend you just use System.Process, or
+[Data.Streaming.Process](http://hackage.haskell.org/package/streaming-commons-0.1.12/docs/Data-Streaming-Process.html).
+Although there is the problem that `PROPELLOR_DEBUG` relies on
+Utility.Process adding calls to debugging functions, so you'd need to do that
+by hand.
+
+Maybe what makes sense is for some part of propellor to re-export qualified
+subsets of `Utility.*`, on a case-by-case basis as users find need for them.
+I counted the Utility imports inside Propellor.Property, they are:
+
+ 17 import Utility.SafeCommand
+ 8 import Utility.FileMode
+ 2 import Utility.Path
+ 2 import Utility.Env
+ 2 import Utility.DataUnits
+ 1 import Utility.ThreadScheduler
+ 1 import Utility.Scheduled
+ 1 import Utility.FileSystemEncoding
+ 1 import Utility.Applicative
+
+So, I'm inclined to have Propellor.Property.Cmd re-export Utility.SafeCommand,
+and leave it at that for now. It makes sense that propellor export a primitive
+that runs a command to a Bool, does any requested debug output, for use by the
+many Properties that involve running commands.
+
+(If you want to break out some part of Utility into a separate library
+and maintain it, I'd be ok with that too.)
+"""]]
diff --git a/doc/forum/running_propellor_as_a_library/comment_2_1174504655ffaf7ebc507e915cc26c84._comment b/doc/forum/running_propellor_as_a_library/comment_2_1174504655ffaf7ebc507e915cc26c84._comment
new file mode 100644
index 00000000..dd019d9d
--- /dev/null
+++ b/doc/forum/running_propellor_as_a_library/comment_2_1174504655ffaf7ebc507e915cc26c84._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-05-27T16:40:29Z"
+ content="""
+Ok, I've made Propellor.Property.Cmd export most of Utility.SafeCommand.
+"""]]
diff --git a/doc/forum/running_propellor_as_a_library/comment_3_3e3961587228eb030ff8f704c71b00a5._comment b/doc/forum/running_propellor_as_a_library/comment_3_3e3961587228eb030ff8f704c71b00a5._comment
new file mode 100644
index 00000000..17f04c3b
--- /dev/null
+++ b/doc/forum/running_propellor_as_a_library/comment_3_3e3961587228eb030ff8f704c71b00a5._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="arnaud.oqube@c9b8c7ea33f1dea0b7a5485b86825c5bfa9efbf7"
+ nickname="arnaud.oqube"
+ subject="Thanks"
+ date="2015-05-27T19:05:19Z"
+ content="""
+... a lot for your reactivity! Actually that's fine because we use mostly `boolSystem` from `Utility.SafeCommand`. We also use `transcript` to retrieve output of a process. So you say it is better to use directly `System.Process` ?
+"""]]
diff --git a/doc/forum/running_propellor_as_a_library/comment_4_c5ec270ca7cb1b6ae66cd7b9dc4e4aac._comment b/doc/forum/running_propellor_as_a_library/comment_4_c5ec270ca7cb1b6ae66cd7b9dc4e4aac._comment
new file mode 100644
index 00000000..18b44482
--- /dev/null
+++ b/doc/forum/running_propellor_as_a_library/comment_4_c5ec270ca7cb1b6ae66cd7b9dc4e4aac._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2015-05-30T15:06:06Z"
+ content="""
+I have made Propellor.Property.Cmd re-export the wrapped createProcess
+that does debug logging.
+
+I can see how processTranscript would be useful. I'm on the fence about
+re-exporting that one.
+"""]]
diff --git a/doc/forum/running_propellor_as_a_library/comment_5_39c24e955e290f045b8f6d5b9ed9f688._comment b/doc/forum/running_propellor_as_a_library/comment_5_39c24e955e290f045b8f6d5b9ed9f688._comment
new file mode 100644
index 00000000..1787b6ab
--- /dev/null
+++ b/doc/forum/running_propellor_as_a_library/comment_5_39c24e955e290f045b8f6d5b9ed9f688._comment
@@ -0,0 +1,36 @@
+[[!comment format=mdwn
+ username="arnaud@30aba4d9f1742050874551d3ddc55ca8694809f8"
+ nickname="arnaud"
+ subject="Using propellor as a library breaks build"
+ date="2015-10-12T10:24:34Z"
+ content="""
+I am reviving that old thread because I upgraded my configuration to use recent propellor and moved some part of our system to use propellor as a library, and it failed building propellor on the remote configured host due to dependencies version conflict. Here is the output:
+
+ Resolving dependencaies...
+ In order, the following would bbe installed:
+ network-2.6.2.1 (new version)
+ transformers-0.4.3.0 (new version)
+ monads-tf-0.1.0.2 (new package)
+ MonadCatchIO-transfaormers-0.3.1.3 (new version)
+ mtl-2.2.1 (new version)
+ hslogger-1.2.9 (new version)
+ parsec-3.1.9 (new version)
+ regex-base-0.93.2 (reinstall) changes: mtl-2.1.2 -> 2.2.1
+ regex-posix-0.95.2 (reinsltall)
+ regex-compat-0.95.1 (reinstall)
+ MissingH-1.3.0.1 (new version)
+ transformers-compat-0.4.0.4 (new package)
+ exceptions-0.8.0.2 (new version):
+ propellor-2.7.3 (new package)
+ The following packages are likely to be broken by the reinstalls:
+ MissingH-1.2.0.0
+ Use --force-reinstalls if you want to install anyway.
+ Resolving dependencies...
+ Configuring prod-0.0.1...
+ cabal: At least the following dependencies are missing:
+ propellor ==2.7.3
+ sh: 1: ./propellor: not found
+
+
+Am I missing something?
+"""]]
diff --git a/doc/forum/trying_to_--spin_to_a_sid+experimental_machine.mdwn b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine.mdwn
new file mode 100644
index 00000000..1fde595c
--- /dev/null
+++ b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine.mdwn
@@ -0,0 +1,290 @@
+I'm trying to get propellor running, and for now, I'd prefer
+to not use a central git repo, according to what I have read
+
+```
+ propellor --spin host
+```
+
+should do just that: not use git.
+
+So I have cabal installed propellor locally, and
+in addition cloned
+
+```
+ git clone git://propellor.branchable.com/ .propellor
+```
+
+in my $HOME
+
+My local machine (from where I run propellor) runs debian testing, the
+machine I want to spin to: softland, debian unstable+experimental,
+ie. unstable in general + all things ghc from experimental, to get ghc
+7.8.4 (but not any more than that from experimental).
+
+was not sure, what the right propellor config would be in that case:
+
+```
+& os (System (Debian Experimental) "amd64")
+```
+which I have used, or
+
+```
+ & os (System (Debian Unstable) "amd64")
+```
+because in general I want Unstable
+
+
+First thing I notice, when running
+
+
+```
+$ propellor --spin softland
+```
+
+propellor nevertheless tries to git push (but fails, obviously,
+somewhere down in propellors output):
+
+```
+...
+Building propellor-2.2.1...
+Preprocessing library propellor-2.2.1...
+In-place registering propellor-2.2.1...
+Preprocessing executable 'propellor' for propellor-2.2.1...
+Preprocessing executable 'propellor-config' for propellor-2.2.1...
+Propellor build ... done
+[master 8ca2715] propellor spin
+Git commit ... done
+Counting objects: 10, done.
+Delta compression using up to 2 threads.
+Compressing objects: 100% (8/8), done.
+Writing objects: 100% (10/10), 913 bytes | 0 bytes/s, done.
+Total 10 (delta 6), reused 0 (delta 0)
+remote: you are not allowed to change config.hs
+To git://propellor.branchable.com/
+ ! [remote rejected] master -> master (pre-receive hook declined)
+error: failed to push some refs to 'git://propellor.branchable.com/'
+Push to central git repository ... failed
+Stop listening request sent.
+Hit http://ftp.uk.debian.org sid InRelease
+Hit http://ftp.uk.debian.org experimental InRelease
+Get:1 http://ftp.uk.debian.org sid/main amd64 Packages/DiffIndex [7,876 B]
+...
+```
+
+Note in particular the lines:
+
+```
+ To git://propellor.branchable.com/
+ ! [remote rejected] master -> master (pre-receive hook declined)
+ error: failed to push some refs to 'git://propellor.branchable.com/'
+ Push to central git repository ... failed
+```
+
+Shouldn't propellor be completely quiet about git /
+not try to push at all?
+
+OK, never mind, let's see what's next: some long
+output, propellor finally fails, I assume it's because
+of my sid+experimental configuration?
+
+
+```
+Stop listening request sent.
+Hit http://ftp.uk.debian.org sid InRelease
+Hit http://ftp.uk.debian.org experimental InRelease
+Get:1 http://ftp.uk.debian.org sid/main amd64 Packages/DiffIndex [7,876 B]
+Get:2 http://ftp.uk.debian.org sid/contrib amd64 Packages/DiffIndex [7,819 B]
+Get:3 http://ftp.uk.debian.org sid/non-free amd64 Packages/DiffIndex [7,819 B]
+Get:4 http://ftp.uk.debian.org sid/contrib Translation-en/DiffIndex [7,819 B]
+Get:5 http://ftp.uk.debian.org sid/main Translation-en/DiffIndex [7,876 B]
+Get:6 http://ftp.uk.debian.org sid/non-free Translation-en/DiffIndex [7,819 B]
+Get:7 http://ftp.uk.debian.org sid/main Sources [7,633 kB]
+Get:8 http://ftp.uk.debian.org sid/contrib Sources [57.1 kB]
+Get:9 http://ftp.uk.debian.org sid/non-free Sources [105 kB]
+Get:10 http://ftp.uk.debian.org experimental/main Sources/DiffIndex [7,819 B]
+Get:11 http://ftp.uk.debian.org experimental/contrib Sources/DiffIndex [7,819 B]
+Get:12 http://ftp.uk.debian.org experimental/non-free Sources/DiffIndex [7,819 B]
+Get:13 http://ftp.uk.debian.org experimental/main amd64 Packages/DiffIndex [7,819 B]
+Get:14 http://ftp.uk.debian.org experimental/contrib amd64 Packages/DiffIndex [7,819 B]
+Get:15 http://ftp.uk.debian.org experimental/contrib Translation-en/DiffIndex [7,819 B]
+Get:16 http://ftp.uk.debian.org experimental/main Translation-en/DiffIndex [7,819 B]
+Fetched 7,897 kB in 6s (1,169 kB/s)
+Reading package lists...
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Skipping gnupg, it is already installed and upgrade is not set.
+0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Skipping ghc, it is already installed and upgrade is not set.
+0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Skipping cabal-install, it is already installed and upgrade is not set.
+0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Skipping libghc-async-dev, it is already installed and upgrade is not set.
+0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Some packages could not be installed. This may mean that you have
+requested an impossible situation or if you are using the unstable
+distribution that some required packages have not yet been created
+or been moved out of Incoming.
+The following information may help to resolve the situation:
+The following packages have unmet dependencies:
+ libghc-missingh-dev : Depends: libghc-hunit-dev-1.2.5.2-6e02e
+ Depends: libghc-array-dev-0.4.0.1-3b784
+ Depends: libghc-base-dev-4.6.0.1-8aa5d
+ Depends: libghc-containers-dev-0.5.0.0-ab1da
+ Depends: libghc-directory-dev-1.2.0.1-91a78
+ Depends: libghc-filepath-dev-1.3.0.1-b12cb
+ Depends: libghc-hslogger-dev-1.2.1-028cc
+ Depends: libghc-mtl-dev-2.1.2-94c72
+ Depends: libghc-network-dev-2.4.1.2-040ce
+ Depends: libghc-old-locale-dev-1.0.0.5-6729c
+ Depends: libghc-old-time-dev-1.1.0.1-2f8ea
+ Depends: libghc-parsec-dev-3.1.3-6c6e2
+ Depends: libghc-process-dev-1.1.0.2-76e05
+ Depends: libghc-random-dev-1.0.1.1-43fdc
+ Depends: libghc-regex-compat-dev-0.95.1-121c7
+ Depends: libghc-time-dev-1.4.0.1-10dc4
+ Depends: libghc-unix-dev-2.6.0.1-4f219
+E: Unable to correct problems, you have held broken packages.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Some packages could not be installed. This may mean that you have
+requested an impossible situation or if you are using the unstable
+distribution that some required packages have not yet been created
+or been moved out of Incoming.
+The following information may help to resolve the situation:
+The following packages have unmet dependencies:
+ libghc-hslogger-dev : Depends: libghc-base-dev-4.6.0.1-8aa5d
+ Depends: libghc-containers-dev-0.5.0.0-ab1da
+ Depends: libghc-directory-dev-1.2.0.1-91a78
+ Depends: libghc-mtl-dev-2.1.2-94c72
+ Depends: libghc-network-dev-2.4.1.2-040ce
+ Depends: libghc-old-locale-dev-1.0.0.5-6729c
+ Depends: libghc-process-dev-1.1.0.2-76e05
+ Depends: libghc-time-dev-1.4.0.1-10dc4
+ Depends: libghc-unix-dev-2.6.0.1-4f219
+E: Unable to correct problems, you have held broken packages.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Some packages could not be installed. This may mean that you have
+requested an impossible situation or if you are using the unstable
+distribution that some required packages have not yet been created
+or been moved out of Incoming.
+The following information may help to resolve the situation:
+The following packages have unmet dependencies:
+ libghc-unix-compat-dev : Depends: libghc-base-dev-4.6.0.1-8aa5d
+ Depends: libghc-unix-dev-2.6.0.1-4f219
+E: Unable to correct problems, you have held broken packages.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Skipping libghc-ansi-terminal-dev, it is already installed and upgrade is not set.
+0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Some packages could not be installed. This may mean that you have
+requested an impossible situation or if you are using the unstable
+distribution that some required packages have not yet been created
+or been moved out of Incoming.
+The following information may help to resolve the situation:
+The following packages have unmet dependencies:
+ libghc-ifelse-dev : Depends: libghc-base-dev-4.6.0.1-8aa5d
+E: Unable to correct problems, you have held broken packages.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Skipping libghc-network-dev, it is already installed and upgrade is not set.
+0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Skipping libghc-quickcheck2-dev, it is already installed and upgrade is not set.
+0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Skipping libghc-mtl-dev, it is already installed and upgrade is not set.
+0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded.
+Reading package lists...
+Building dependency tree...
+Reading state information...
+Some packages could not be installed. This may mean that you have
+requested an impossible situation or if you are using the unstable
+distribution that some required packages have not yet been created
+or been moved out of Incoming.
+The following information may help to resolve the situation:
+The following packages have unmet dependencies:
+ libghc-monadcatchio-transformers-dev : Depends: libghc-base-dev-4.6.0.1-8aa5d
+ Depends: libghc-extensible-exceptions-dev-0.1.1.4-255a3
+ Depends: libghc-monads-tf-dev-0.1.0.2-731f0
+ Depends: libghc-transformers-dev-0.3.0.0-ff2bb
+E: Unable to correct problems, you have held broken packages.
+Downloading the latest package list from hackage.haskell.org
+Skipping download: Local and remote files match.
+Resolving dependencies...
+All the requested packages are already installed:
+Use --reinstall if you want to reinstall anyway.
+Resolving dependencies...
+Configuring propellor-2.2.1...
+Building propellor-2.2.1...
+Preprocessing library propellor-2.2.1...
+In-place registering propellor-2.2.1...
+Preprocessing executable 'propellor' for propellor-2.2.1...
+Preprocessing excaecutable 'propellor-bal: can't find source for configconf in src
+ig' for propellor-2.2.1...
+propellor: user error (ssh ["-o","ControlPath=/home/rx/.ssh/propellor/softland.sock","-o","ControlMaster=auto","-o","ControlPersist=yes","root@softland","sh -c 'if [ ! -d /usr/local/propellor/.git ] ; then (if ! git --version >/dev/null; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git; fi && echo STATUSNeedGitClone) || echo STATUSNeedPrecompiled ; else cd /usr/local/propellor && if ! test -x ./propellor; then ( apt-get update ; apt-get --no-upgrade --no-install-recommends -y install gnupg ; apt-get --no-upgrade --no-install-recommends -y install ghc ; apt-get --no-upgrade --no-install-recommends -y install cabal-install ; apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-missingh-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-hslogger-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-unix-compat-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-ansi-terminal-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-ifelse-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-network-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-quickcheck2-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-mtl-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-monadcatchio-transformers-dev ; cabal update ; cabal install --only-dependencies ) || true && cabal configure && cabal build && ln -sf dist/build/propellor-config/propellor-config propellor; fi && ./propellor --boot softland ; fi'"] exited 1)
+rx@varenne ~/work/propellor $
+```
+
+I should add, that I have tried to --spin to another
+machine, and ... finally got that working:
+
+
+```
+ , host "laptop"
+ & os (System (Debian Testing) "amd64")
+```
+
+Not sure, if I need more than that, want to keep it to the
+minimum first, anyway:
+
+
+```
+ propellor --spin laptop
+```
+
+this works, yeah - sorry for the noise, above - but still I get
+
+
+```
+Git commit ... done
+To git://propellor.branchable.com/
+ ! [rejected] master -> master (fetch first)
+error: failed to push some refs to 'git://propellor.branchable.com/'
+hint: Updates were rejected because the remote contains work that you do
+hint: not have locally. This is usually caused by another repository pushing
+hint: to the same ref. You may want to first integrate the remote changes
+hint: (e.g., 'git pull ...') before pushing again.
+hint: See the 'Note about fast-forwards' in 'git push --help' for details.
+Push to central git repository ... failed
+```
+
+Possible to turn off these git push attempts?
+
+
+Thanks,
+ Andreas
diff --git a/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_1_df7ac45d7e576e8d73a8665521dbd6e0._comment b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_1_df7ac45d7e576e8d73a8665521dbd6e0._comment
new file mode 100644
index 00000000..cfe1750a
--- /dev/null
+++ b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_1_df7ac45d7e576e8d73a8665521dbd6e0._comment
@@ -0,0 +1,29 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawm-czsfuWENKQ0GI8l0gnGTeF1JEli1mA0"
+ nickname="Andreas"
+ subject="finally got it working"
+ date="2015-03-27T05:15:26Z"
+ content="""
+can spin to softland, my sid+experimental host now.
+
+with recent git://propellor.branchable.com/ updates
+and have used:
+
+```
+ & os (System (Debian Experimental) \"amd64\")
+```
+
+so sorry for the noise, still not sure about:
+
+* how to express my installation properly:
+ mostly unstable, ghc stuff from experimental
+
+* how to turn off the git push to branchable attempts
+ when just spinning to one of my mashines:
+ have set now:
+ ```
+ git branch --unset-upstream
+ ```
+ which shortcuts these attempts at least.
+
+"""]]
diff --git a/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_2_8600d257d92f786f2fcf0d4934f727d5._comment b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_2_8600d257d92f786f2fcf0d4934f727d5._comment
new file mode 100644
index 00000000..51c3fc53
--- /dev/null
+++ b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_2_8600d257d92f786f2fcf0d4934f727d5._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-03-30T23:22:17Z"
+ content="""
+Pushing to origin is needed when using propellor in the central git
+repository deployment mode. So it makes sense for --spin to try to push.
+If that push fails for some reason, it's not a fatal error, since propellor
+--spin also does peer-to-peer pushes.
+
+I don't think I want to get into trying to determine if a particular origin
+repo url is read-only or read-write. It can be hard to tell with eg
+a https url.
+
+Why don't you just `git remote rename origin upstream`? If the remote
+is not called origin, propellor will ignore it.
+"""]]
diff --git a/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_3_f1ca62944fe0303db6f1dc0916e8c967._comment b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_3_f1ca62944fe0303db6f1dc0916e8c967._comment
new file mode 100644
index 00000000..ed34d6a7
--- /dev/null
+++ b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_3_f1ca62944fe0303db6f1dc0916e8c967._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-03-30T23:26:38Z"
+ content="""
+As to a mixed unstable/experimental machine, such a machine has a Property
+of having somepackage installed from experimental. One way to represent
+that is by defining a property:
+
+installedFromExperimental :: [Package] -> Property NoInfo
+installedFromExperimental = Apt.installed' ["-y", "-texperimental"]
+
+"""]]
diff --git a/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_4_d0d946df7455d079af9bc331da6fac55._comment b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_4_d0d946df7455d079af9bc331da6fac55._comment
new file mode 100644
index 00000000..72b21450
--- /dev/null
+++ b/doc/forum/trying_to_--spin_to_a_sid+experimental_machine/comment_4_d0d946df7455d079af9bc331da6fac55._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawm-czsfuWENKQ0GI8l0gnGTeF1JEli1mA0"
+ nickname="Andreas"
+ subject="thanks a lot"
+ date="2015-04-06T21:11:46Z"
+ content="""
+thanks for your your commments (both of them),
+and fair enough: have just renamed my origin remote to upstream,
+will try your installedFromExperimental suggestion next.
+
+
+I will have more questions about propellor,
+but aske them in a different thread
+(as they are not really about installation)
+
+"""]]
diff --git a/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket.mdwn b/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket.mdwn
new file mode 100644
index 00000000..b1a113ff
--- /dev/null
+++ b/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket.mdwn
@@ -0,0 +1,7 @@
+Hello,
+
+when I try to run propellor, I get this error message.
+
+ unix_listener: "/home/experiences/instrumentation/picca/.ssh/propellor/diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I" too long for Unix domain socket
+ [2016-03-25 15:20:44 CET] process done ExitFailure 255
+ propellor: user error (ssh ["-o","ControlPath=/home/experiences/instrumentation/picca/.ssh/propellor/diffabs6.exp.synchrotron-soleil.fr.sock","-o","ControlMaster=auto","-o","ControlPersist=yes","root@diffabs6.exp.synchrotron-soleil.fr","sh -c 'if [ ! -d /usr/local/propellor/.git ] ; then (if ! git --version >/dev/null; then apt-get update && DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git; fi && echo STATUSNeedGitClone) || echo STATUSNeedPrecompiled ; else cd /usr/local/propellor && if ! cabal configure >/dev/null 2>&1; then ( apt-get update ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install gnupg ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install ghc ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install cabal-install ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-missingh-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-hslogger-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-unix-compat-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-ansi-terminal-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-ifelse-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-network-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-mtl-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-transformers-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-exceptions-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-stm-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install libghc-text-dev ; DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install make ; cabal update ; cabal install --only-dependencies ) || true; fi&& if ! test -x ./propellor; then cabal configure && cabal build && ln -sf dist/build/propellor-config/propellor-config propellor; fi;if test -x ./propellor && ! ./propellor --check 2>/dev/null; then cabal clean && cabal configure && cabal build && ln -sf dist/build/propellor-config/propellor-config propellor; fi && ./propellor --boot diffabs6.exp.synchrotron-soleil.fr ; fi'"] exited 255)
diff --git a/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket/comment_1_9d72cfc76d5ef15de5de54be2567a23e._comment b/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket/comment_1_9d72cfc76d5ef15de5de54be2567a23e._comment
new file mode 100644
index 00000000..642eae7b
--- /dev/null
+++ b/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket/comment_1_9d72cfc76d5ef15de5de54be2567a23e._comment
@@ -0,0 +1,33 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-03-25T20:39:29Z"
+ content="""
+What's going on here is propellor has asked ssh to use that as a socket,
+but unix has a hoary old limit on the length of filenames to unix domain
+sockets -- something around 100 characters max depending on the OS (108 on
+linux I believe).
+
+40 characters of that budget is used up by the somewhat long HOME path, 17
+characters are tacked on by ssh (for no really good reason given the
+limited budget). This leaves propellor 57 characters to make a unique
+socket name that's not too ugly, but it decided to put the whole hostname
+in there, which blows past the budget in this case.
+
+So, I have changed the code to try to respect the budget while still coming
+up with the best filename it can.
+
+So in your case the new path will be something like
+"/home/experiences/instrumentation/picca/.ssh/propellor/diffabs6.e-44ecb7d0.j3awdJtqk5r3HB1I"
+-- 91 bytes, so under the limit.
+
+If someone has HOME set to something longer than ~60 characters,
+propellor will still break. Since the socket file has to be at a
+stable location, and so more or less needs to live under HOME, it's hard to
+avoid the problem entirely.
+
+I did consider moving the sockets to /tmp to avoid HOME length causing a
+problem, but then other users on the system could DOS propellor by creating
+the directory in /tmp, which would at best make it fall back to not using
+the ssh socket and so asking repeatedly for passwords.
+"""]]
diff --git a/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket/comment_2_28706044d9cc744148c6744577afd261._comment b/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket/comment_2_28706044d9cc744148c6744577afd261._comment
new file mode 100644
index 00000000..2423a91e
--- /dev/null
+++ b/doc/forum/unix__95__listener:___34____47__home__47__experiences__47__instrumentation__47__picca__47__.ssh__47__propellor__47__diffabs6.exp.synchrotron-soleil.fr.sock.j3awdJtqk5r3HB1I__34___too_long_for_Unix_domain_socket/comment_2_28706044d9cc744148c6744577afd261._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-03-25T21:26:20Z"
+ content="""
+If someone wants to improve this more later, it would suffice to make
+`sshCachingParams` fall back to using a temp file in /tmp for the socket
+when HOME is too long, as long as repeated calls to `sshCachingParams`
+inside the same propellor process returned the same temp file each time
+(for a given HostName). Of course, the temp files would need to be cleaned
+up when propellor exists.
+"""]]
diff --git a/doc/forum/upgrading_to_propellor_3.0.mdwn b/doc/forum/upgrading_to_propellor_3.0.mdwn
new file mode 100644
index 00000000..b81a6a94
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0.mdwn
@@ -0,0 +1,85 @@
+Propellor 3.0 is a major new version with large changes to the API.
+
+Property types have been improved to indicate what systems they target.
+This prevents using eg, Property FreeBSD on a Debian system.
+
+This forum topic is to help users with the upgrade. Post comments
+if you're having trouble and [[Joey]] will get back to you. ;)
+
+Now, the transition guide as far as your config.hs goes:
+
+* Add `props` to host definitions.
+
+ host name
+ & foo
+ & bar
+
+ Becomes
+
+ host name $ props
+ & foo
+ & bar
+
+* Similarly, `propertyList` and `combineProperties` need `props`
+ to be used to combine together properties; they no longer accept
+ lists of properties. (If you have such a list, use `toProps`.)
+* And similarly, Chroot, Docker, and Systemd container need `props`
+ to be used to combine together the properies used inside them.
+* The `os` property is removed. Instead use `osDebian`, `osBuntish`,
+ or `osFreeBSD`. These tell the type checker the target OS of a host.
+* GHC needs `{-# LANGUAGE TypeOperators #-}` to use these fancy types.
+ This is enabled by default for all modules in propellor.cabal. But
+ if you are using propellor as a library, you may need to enable it
+ manually.
+
+Additional things you need to do if you've written your own properties:
+
+* Change `Property NoInfo` to `Property UnixLike`
+* Change `Property HasInfo` to `Property (HasInfo + UnixLike)`
+* Change `RevertableProperty NoInfo` to
+ `RevertableProperty UnixLike UnixLike`
+* Change `RevertableProperty HasInfo` to
+ `RevertableProperty (HasInfo + UnixLike) UnixLike`
+* If you know a property only works on a particular OS, like `Debian`
+ or `FreeBSD`, use that instead of `UnixLike`. For example:
+ `Property Debian`
+* It's also possible make a property support a set of OS's, for example:
+ `Property (Debian + FreeBSD)`
+* Removed `infoProperty` and `simpleProperty` constructors, instead use
+ `property` to construct a Property.
+* Due to the polymorphic type returned by `property`, additional type
+ signatures tend to be needed when using it. For example, this will
+ fail to type check, because the type checker cannot guess what type
+ you intend the intermediate property `go` to have:
+
+ foo :: Property UnixLike
+ foo = go `requires` bar
+ where
+ go = property "foo" (return NoChange)
+
+ To fix, specify the type of go:
+
+ go :: Property UnixLike
+
+* `ensureProperty` now needs to be passed a witness to the type of the
+ property it's used in.
+
+ foo = property desc $ ... ensureProperty bar
+
+ Becomes
+
+ foo = property' desc $ \w -> ... ensureProperty w bar
+
+* General purpose properties like cmdProperty have type `Property UnixLike`.
+ When using that to run a command only available on Debian, you can
+ tighten the type to only the OS that your more specific property works on.
+ For example:
+
+ upgraded :: Property Debian
+ upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
+
+* Several utility functions have been renamed:
+ getInfo to fromInfo
+ propertyInfo to getInfo
+ propertyDesc to getDesc
+ propertyChildren to getChildren
diff --git a/doc/forum/upgrading_to_propellor_3.0/comment_1_ddf4b31102bf16a34afaa6f77e8464d1._comment b/doc/forum/upgrading_to_propellor_3.0/comment_1_ddf4b31102bf16a34afaa6f77e8464d1._comment
new file mode 100644
index 00000000..da4ee68b
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0/comment_1_ddf4b31102bf16a34afaa6f77e8464d1._comment
@@ -0,0 +1,135 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="How to migrate this property"
+ date="2016-04-13T08:52:10Z"
+ content="""
+Hello, I am trying to migrate this property
+
+ -- | Property used to setup a schroot used by sbuild
+ -- > schroot \"jessie-i386-sbuild\"
+ -- > debootstrapped Debootstrap.BuildD \"/srv/chroot/ghc-dev\"
+ -- > & os (System (Debian (Stable \"jessie\")) \"i386\")
+ -- > & Apt.installed [\"ghc\", \"haskell-platform\"]
+ -- > & ...
+ schroot :: SchrootName -> Chroot -> RevertableProperty (HasInfo + DebianLike) DebianLike
+ schroot sn chroot@(Chroot.Chroot chrootdir _ _) = (setup `requires` installed) <!> cleanup
+ where
+ setup :: Property (HasInfo + DebianLike)
+ setup = conf `requires` (provision `onChange` targz)
+ where
+ provision :: Property (HasInfo + DebianLike)
+ provision = toChildProperty (Chroot.provisioned chroot) `before` umount
+ where
+ umount = property (\"umount \" ++ chrootdir) $ do
+ liftIO $ Mount.unmountBelow chrootdir
+ return NoChange
+ targz = createTarball chrootdir tarball
+ conf = chrootConf sn tarball
+ cleanup :: Property DebianLike
+ cleanup = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toChildProperty (revert (Chroot.provisioned chroot))
+ tarball = chrootdir <.> \"tar.gz\"
+
+
+and when I compile it I get this error message
+
+ src/Propellor/Property/Sbuild.hs:79:25-83:
+
+ Couldn't match type ‘CombinedType
+ ChildProperty (Property (MetaTypes metatypes1))’
+ with ‘Property
+ (MetaTypes
+ '['WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])’
+ The type variable ‘metatypes1’ is ambiguous
+ Expected type: Property (HasInfo + DebianLike)
+ Actual type: CombinedType
+ ChildProperty (Property (MetaTypes metatypes1))
+ Relevant bindings include
+ umount :: Property (MetaTypes metatypes1)
+ (bound at src/Propellor/Property/Sbuild.hs:81:19)
+ In the expression:
+ toChildProperty (Chroot.provisioned chroot) `before` umount
+ In an equation for ‘provision’:
+ provision
+ = toChildProperty (Chroot.provisioned chroot) `before` umount
+ where
+ umount
+ = property (\"umount \" ++ chrootdir)
+ $ do { liftIO $ Mount.unmountBelow chrootdir;
+ .... }
+ In an equation for ‘setup’:
+ setup
+ = conf `requires` (provision `onChange` targz)
+ where
+ provision :: Property (HasInfo + DebianLike)
+ provision
+ = toChildProperty (Chroot.provisioned chroot) `before` umount
+ where
+ umount = property (\"umount \" ++ chrootdir) $ ...
+ targz = createTarball chrootdir tarball
+ conf = chrootConf sn tarball
+
+ src/Propellor/Property/Sbuild.hs:(87,17)-(89,79):
+
+ Couldn't match expected type ‘Property DebianLike’
+ with actual type ‘CombinedType
+ (Property
+ (MetaTypes
+ '['Targeting 'OSDebian, 'Targeting 'OSBuntish,
+ 'Targeting 'OSFreeBSD]))
+ ChildProperty’
+ In the expression:
+ File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toChildProperty (revert (Chroot.provisioned chroot))
+ In an equation for ‘cleanup’:
+ cleanup
+ = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toChildProperty (revert (Chroot.provisioned chroot))
+ In an equation for ‘schroot’:
+ schroot sn chroot@(Chroot.Chroot chrootdir _ _)
+ = (setup `requires` installed) <!> cleanup
+ where
+ setup :: Property (HasInfo + DebianLike)
+ setup
+ = conf `requires` (provision `onChange` targz)
+ where
+ provision :: Property (HasInfo + DebianLike)
+ provision
+ = toChildProperty (Chroot.provisioned chroot) `before` umount
+ where
+ ...
+ ....
+ cleanup :: Property DebianLike
+ cleanup
+ = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` toChildProperty (revert (Chroot.provisioned chroot))
+ ....
+
+ src/Propellor/Property/Sbuild.hs:98:18-42:
+
+ Couldn't match expected type ‘Property DebianLike’
+ with actual type ‘CombinedType
+ (Property (MetaTypes metatypes0)) (Property DebianLike)’
+ The type variable ‘metatypes0’ is ambiguous
+ Relevant bindings include
+ prop :: Property (MetaTypes metatypes0)
+ (bound at src/Propellor/Property/Sbuild.hs:100:5)
+ In the expression: prop `requires` installed
+ In an equation for ‘addUsers’:
+ addUsers users
+ = prop `requires` installed
+ where
+ prop
+ = property (\"sbuild add users \" ++ unwords names)
+ $ liftIO
+ $ toResult
+ <$> boolSystem \"sbuild-adduser\" [Param user | user <- names]
+ where
+ names = ...
+
+so my question is what is wrong with my code :))
+"""]]
diff --git a/doc/forum/upgrading_to_propellor_3.0/comment_2_ce961eb3a2a006ecce09eb7f9bd550cf._comment b/doc/forum/upgrading_to_propellor_3.0/comment_2_ce961eb3a2a006ecce09eb7f9bd550cf._comment
new file mode 100644
index 00000000..91f22a3b
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0/comment_2_ce961eb3a2a006ecce09eb7f9bd550cf._comment
@@ -0,0 +1,63 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-04-13T16:14:46Z"
+ content="""
+There are a few things in your example that seem to reference other
+parts of your schroot module, which I don't have handy. But, I was able
+to add dummy versions of those (hopefully with close to the real types)
+and reproduce what looks like the same type errors.
+
+Let's first deal with "type variable x is ambiguous". Because if the type
+checker cannot infer a type, the other errors are not likely to be useful.
+
+So, the first of these involves the definition of `umount`, which uses
+`property`. And like it says in the transition guide:
+
+> Due to the polymorphic type returned by `property`, additional type
+> signatures tend to be needed when using it.
+
+So, write down the type of `umount` to fix this.
+
+ umount :: Property Linux
+
+Next thing that stuck out to me is that two places are using
+`toChildProperty`. I'm at a bit of a loss to why, this is a new function
+that's a bit of an implementation detail, documented as "Gets a
+ChildProperty representing the Property. You should not normally need to
+use this." And indeed, you do not need to use it here. I simply removed it,
+and the types lined up without it, hurrah!
+
+With those fixes, my version of the code is compiling.
+
+ schroot :: String -> Chroot -> RevertableProperty (HasInfo + DebianLike) DebianLike
+ schroot sn chroot@(Chroot.Chroot chrootdir _ _) = (setup `requires` installed) <!> cleanup
+ where
+ setup :: Property (HasInfo + DebianLike)
+ setup = conf `requires` (provision `onChange` targz)
+ where
+ provision :: Property (HasInfo + DebianLike)
+ provision = Chroot.provisioned chroot `before` umount
+ where
+ umount :: Property Linux
+ umount = property ("umount " ++ chrootdir) $ do
+ liftIO $ Mount.unmountBelow chrootdir
+ return NoChange
+ cleanup :: Property DebianLike
+ cleanup = File.notPresent (schrootChrootD </> sn)
+ `requires` File.notPresent tarball
+ `requires` revert (Chroot.provisioned chroot)
+ tarball = chrootdir <.> "tar.gz"
+ -- dummy stuff added to make it compile as I don't have the real
+ -- stuff handy.
+ installed = undefined :: Property DebianLike
+ conf = undefined :: Property DebianLike
+ targz = undefined :: Property DebianLike
+ schrootChrootD = undefined :: FilePath
+
+Hope this helps!
+
+BTW, looks like you also have a type error outside the code you showed,
+on line 98 of Sbuild.hs, which again looks to need the type of `property`
+to be explicitly specified to fix it.
+"""]]
diff --git a/doc/forum/upgrading_to_propellor_3.0/comment_3_88584d22eb238dc172cb3b4f2f6d30fc._comment b/doc/forum/upgrading_to_propellor_3.0/comment_3_88584d22eb238dc172cb3b4f2f6d30fc._comment
new file mode 100644
index 00000000..8f1d290e
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0/comment_3_88584d22eb238dc172cb3b4f2f6d30fc._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="picca"
+ subject="comment 3"
+ date="2016-04-15T18:42:46Z"
+ content="""
+Thanks to your help I could convert my config.h... BUT now the compilation of my config.hs files eat all my RAM and faild after filling all the swap.
+I have a small computer i386 with only 700 Mo of RAM. Are you aware of this sort of \"side effect\" ;) with 3.0.1 ?
+"""]]
diff --git a/doc/forum/upgrading_to_propellor_3.0/comment_4_71afd4663589c1aad367c071c6cdd24a._comment b/doc/forum/upgrading_to_propellor_3.0/comment_4_71afd4663589c1aad367c071c6cdd24a._comment
new file mode 100644
index 00000000..fd9c192d
--- /dev/null
+++ b/doc/forum/upgrading_to_propellor_3.0/comment_4_71afd4663589c1aad367c071c6cdd24a._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-04-15T22:58:44Z"
+ content="""
+Memory use did go up. Building with -O0 helped a lot for me, and it's doing
+ok on a 500 mb memory machine. So I recommend -O0 in your cabal file if you
+don't have that already.
+
+I wrote down my memory benchmarks here:
+<http://source.propellor.branchable.com/?p=source.git;a=commit;h=af7b2d61c0c7f9b4fe53d8f5d18b5426a93cbd7b>
+"""]]
diff --git a/doc/haskell_newbie.mdwn b/doc/haskell_newbie.mdwn
index f1a81e40..bd343cd6 100644
--- a/doc/haskell_newbie.mdwn
+++ b/doc/haskell_newbie.mdwn
@@ -8,7 +8,7 @@ configure Propellor!
Let's take a quick tour of the `config.hs` file..
[[!format haskell """
--- | This is the main configuration file for Propellor, and is used to build
+-- This is the main configuration file for Propellor, and is used to build
-- the propellor program.
"""]]
@@ -16,7 +16,6 @@ So, `-- ` starts a comment in this file.
[[!format haskell """
import Propellor
-import Propellor.CmdLine
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.User as User
@@ -37,22 +36,29 @@ stub to go run itself. No need to ever change this part.
[[!format haskell """
-- The hosts propellor knows about.
--- Edit this to configure propellor!
hosts :: [Host]
hosts =
- [ host "mybox.example.com"
- & os (System (Debian Unstable) "amd64")
- & Apt.stdSourcesList
- , host "server.example.com"
- & os (System (Debian Stable) "amd64")
- & Apt.stdSourcesList
- & Apt.installed ["ssh"]
- ]
+ [ mylaptop
+ , myserver
+ ]
"""]]
-This defines a list of hosts, with two hosts in it.
+Finally, you need to define the configuration for each host in the list:
-The configuration for the mybox host first tells propellor what
+[[!format haskell """
+mylaptop :: Host
+mylaptop = host "mylaptop.example.com"
+ & osDebian Unstable "amd64"
+ & Apt.stdSourcesList
+
+myserver :: Host
+myserver = host "server.example.com"
+ & osDebian (Stable "jessie") "amd64"
+ & Apt.stdSourcesList
+ & Apt.installed ["ssh"]
+"""]]
+
+The configuration for the mylaptop host first tells propellor what
OS it's running. Then the `stdSourcesList` line tells propellor to
configure its `/etc/apt/sources.list`, using its OS.
(Of course you might want to change that `Unstable` to `Stable`.)
@@ -64,9 +70,9 @@ Some other properties you may find in your config.hs, or want to add:
[[!format haskell """
& Apt.unattendedUpgrades
- & User.hasSomePassword "root"
+ & User.hasSomePassword (User "root")
& "/etc/default/foodaemon" `File.containsLine` "ENABLED=yes"
- & Cron.runPropellor "30 * * * *"
+ & Cron.runPropellor (Cron.Times "30 * * * *")
"""]]
Some of these properties can be reverted -- this makes Propellor undo whatever
@@ -90,11 +96,11 @@ is.
<pre>
config.hs:30:19:
Couldn't match expected type `RevertableProperty'
- with actual type `Property'
+ with actual type `Property DebianLike'
In the return type of a call of `Apt.installed'
In the second argument of `(!)', namely `Apt.installed ["ssh"]'
In the first argument of `(&)', namely
- `host "mybox.example.com" & Apt.stdSourcesList Unstable
+ `host "mylaptop.example.com" & Apt.stdSourcesList Unstable
& Apt.unattendedUpgrades
! Apt.installed ["ssh"]'
</pre>
@@ -114,7 +120,8 @@ That's really all there is to configuring Propellor. Once you
have a `config.hs` ready to try out, you can run `propellor --spin $host`
on one of the hosts configured in it.
-See the [[README]] for a further quick start.
+See the [[README]] for a further quick start and [[Writing Properties]]
+for guidance on extending propellor with your own custom properties.
(If you'd like to learn a little Haskell after all, check out
[Learn You a Haskell for Great Good](http://learnyouahaskell.com/).)
diff --git a/doc/index.mdwn b/doc/index.mdwn
index f5fd8806..52c23021 100644
--- a/doc/index.mdwn
+++ b/doc/index.mdwn
@@ -1,9 +1,10 @@
-[[!meta title="propellor: property-based host configuration management in haskell"]]
+[[!meta title="propellor: deploying properties to hosts with haskell"]]
[[!sidebar content="""
[[Install]]
[API documentation](http://hackage.haskell.org/package/propellor)
-[Sample config file](http://git.joeyh.name/?p=propellor.git;a=blob;f=config-joey.hs)
+[[Other Documentation|documentation]]
+[Sample config file](http://git.joeyh.name/?p=propellor.git;a=blob;f=joeyconfig.hs)
[[Security]]
[[Todo]]
[[Forum]]
@@ -11,9 +12,12 @@
[[!inline raw=yes pages="README"]]
-## enjoy
-
-Hope you find Propellor fun and useful!
+<table>
+<tr>
+<td width="50%" valign="top">[[!inline feeds=no template=bare pages=footer/column_a]]</td>
+<td widtd="50%" valign="top">[[!inline feeds=no template=bare pages=footer/column_b]]</td>
+</tr>
+</table>
<pre>
-- _ ______`| ,-.__
@@ -23,11 +27,3 @@ Hope you find Propellor fun and useful!
hosts :: [Host] -- * \ | | '--------'
hosts = -- (o) `
</pre>
-
-Propellor is free software, licensed under the BSD license.
-
-You are encouraged to send patches and improve it. See [[contributing]].
-
-## news
-
-[[!inline pages="news/* and !*/Discussion" show="4" archive=yes]]
diff --git a/doc/interface_stability.mdwn b/doc/interface_stability.mdwn
index 8ad5dfd8..8bccf67c 100644
--- a/doc/interface_stability.mdwn
+++ b/doc/interface_stability.mdwn
@@ -1,8 +1,8 @@
Propellor is versioned using the Haskell [Package Version Policy](https://www.haskell.org/haskellwiki/Package_versioning_policy).
-This means that propellor 0.10.x contains some changes to its API;
-code written for propellor 0.9.x may need to be changed. Conversely,
-there are no breaking changes between 0.10.1 and 0.10.2.
+This means that propellor 2.10.x contains some changes to its API;
+code written for propellor 2.9.x may need to be changed. Conversely,
+there are no breaking changes between 2.10.1 and 2.10.2.
Whenever possible, breaking changes are made in a way that either changes a
data type, or a function name, so that code that used the old API version
diff --git a/doc/mdwn2man b/doc/mdwn2man
new file mode 100755
index 00000000..aadb13cd
--- /dev/null
+++ b/doc/mdwn2man
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+# Warning: hack
+
+my $prog=shift;
+my $section=shift;
+
+print ".TH $prog $section\n";
+
+while (<>) {
+ s{(\\?)\[\[([^\s\|\]]+)(\|[^\s\]]+)?\]\]}{$1 ? "[[$2]]" : $2}eg;
+ s/\`([^\`]*)\`/\\fB$1\\fP/g;
+ s/\`//g;
+ s/^\s*\./\\&./g;
+ if (/^#\s/) {
+ s/^#\s/.SH /;
+ <>; # blank;
+ }
+ s/^[ \n]+//;
+ s/^\t/ /;
+ s/-/\\-/g;
+ s/^Warning:.*//g;
+ s/^$/.PP\n/;
+ s/^\*\s+(.*)/.IP "$1"/;
+ next if $_ eq ".PP\n" && $skippara;
+ if (/^.IP /) {
+ $inlist=1;
+ $spippara=0;
+ }
+ elsif (/^.SH/) {
+ $skippara=0;
+ $inlist=0;
+ }
+ elsif (/^\./) {
+ $skippara=1;
+ }
+ else {
+ $skippara=0;
+ }
+ if ($inlist && $_ eq ".PP\n") {
+ $_=".IP\n";
+ }
+
+ print $_;
+}
diff --git a/doc/news.mdwn b/doc/news.mdwn
new file mode 100644
index 00000000..c59a82fa
--- /dev/null
+++ b/doc/news.mdwn
@@ -0,0 +1,2 @@
+[[!inline pages="news/* and !*/Discussion" show=0 archive=yes
+title="propellor news"]]
diff --git a/doc/news/version_0.8.1.mdwn b/doc/news/version_0.8.1.mdwn
deleted file mode 100644
index 963b4a80..00000000
--- a/doc/news/version_0.8.1.mdwn
+++ /dev/null
@@ -1,7 +0,0 @@
-propellor 0.8.1 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
- * Run apt-get update in initial bootstrap.
- * --list-fields now includes a table of fields that are not currently set,
- but would be used if they got set.
- * Remove .gitignore from cabal file list, to avoid build failure on Debian.
- Closes: #[754334](http://bugs.debian.org/754334)"""]] \ No newline at end of file
diff --git a/doc/news/version_0.8.2.mdwn b/doc/news/version_0.8.2.mdwn
deleted file mode 100644
index d1e9da18..00000000
--- a/doc/news/version_0.8.2.mdwn
+++ /dev/null
@@ -1,10 +0,0 @@
-propellor 0.8.2 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
- * Fix bug in File.containsLines that caused lines that were already in the
- file to sometimes be appended to the end.
- * Hostname.sane also configures /etc/mailname.
- * Fixed Postfix.satellite to really configure relayhost = smtp.domain.
- * Avoid reconfiguring postfix unncessarily when it already has a relayhost.
- * Deal with apache 2.4's change in the name of site-available config files.
- * Hostname aliases can now be used in several places, including --spin
- and Ssh.knownHost."""]] \ No newline at end of file
diff --git a/doc/news/version_0.8.3.mdwn b/doc/news/version_0.8.3.mdwn
deleted file mode 100644
index 82f400c0..00000000
--- a/doc/news/version_0.8.3.mdwn
+++ /dev/null
@@ -1,11 +0,0 @@
-propellor 0.8.3 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
- * The Debian package now includes a single-revision git repository in
- /usr/src/propellor/, and ~/.propellor/ is set up to use this repository as
- its origin remote. This avoids relying on the security of the github
- repository when using the Debian package.
- * The /usr/bin/propellor wrapper will warn when ~/.propellor/ is out of date
- and a newer version is available, after which git merge upstream/master
- can be run to merge it.
- * Included the config.hs symlink to config-simple.hs in the cabal and Debian
- packages."""]] \ No newline at end of file
diff --git a/doc/news/version_0.9.0.mdwn b/doc/news/version_0.9.0.mdwn
deleted file mode 100644
index f50a6b29..00000000
--- a/doc/news/version_0.9.0.mdwn
+++ /dev/null
@@ -1,12 +0,0 @@
-propellor 0.9.0 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
- * Avoid encoding the current stable suite in propellor's code,
- since that poses a difficult transition around the release,
- and can easily be wrong if an older version of propellor is used.
- Instead, the os property for a stable system includes the suite name
- to use, eg Stable "wheezy".
- * stdSourcesList uses the stable suite name, to avoid unwanted
- immediate upgrades to the next stable release.
- * debCdn switched from cdn.debian.net to http.debian.net, which seems to be
- better managed now.
- * Docker: Avoid committing container every time it's started up."""]] \ No newline at end of file
diff --git a/doc/news/version_0.9.1.mdwn b/doc/news/version_0.9.1.mdwn
deleted file mode 100644
index 1a7039cf..00000000
--- a/doc/news/version_0.9.1.mdwn
+++ /dev/null
@@ -1,6 +0,0 @@
-propellor 0.9.1 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
- * Docker: Add ability to control when containers restart.
- * Docker: Default to always restarting containers, so they come back
- up after reboots and docker daemon upgrades.
- * Fix loop when a docker host that does not exist was docked."""]] \ No newline at end of file
diff --git a/doc/news/version_2.15.4.mdwn b/doc/news/version_2.15.4.mdwn
new file mode 100644
index 00000000..4e20bcc9
--- /dev/null
+++ b/doc/news/version_2.15.4.mdwn
@@ -0,0 +1,15 @@
+propellor 2.15.4 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+ * Build /usr/src/propellor/propellor.git reproducibly,
+ which makes the whole Debian package build reproducibly.
+ Thanks, Sean Whitton.
+ * Obnam: To cause old generations to be forgotten, keepParam can be
+ passed to a backup property; this causes obnam forget to be run.
+ * Delete /etc/apt/apt.conf.d/50unattended-upgrades.ucf-dist when
+ unattended-upgrades is installed, to work around #812380 which results
+ in many warnings from apt, including in cron mails.
+ * Added Propellor.Property.LetsEncrypt
+ * Apache.httpsVirtualHost: New property, setting up a https vhost
+ with the certificate automatically obtained using letsencrypt.
+ * Allow using combineProperties and propertyList with lists of
+ RevertableProperty."""]] \ No newline at end of file
diff --git a/doc/news/version_2.16.0.mdwn b/doc/news/version_2.16.0.mdwn
new file mode 100644
index 00000000..b7527f05
--- /dev/null
+++ b/doc/news/version_2.16.0.mdwn
@@ -0,0 +1,18 @@
+propellor 2.16.0 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+ * Obnam: Only let one backup job run at a time when a host has multiple
+ different backup properties, to avoid concurrent jobs fighting over
+ scarce resources (particularly memory). Other jobs block on a lock
+ file.
+ * Removed references to a Debian derivative from code and documentation
+ because of an unfortunate trademark use policy.
+ http://joeyh.name/blog/entry/trademark\_nonsense/
+ * That included changing a data constructor to "Buntish", an API change.
+ * Firewall.rule: Now takes a Table parameter. (API change)
+ * Firewall: add InIFace/OutIFace Rules, add Source/Destination Rules,
+ add CustomTarget, and more improvements.
+ Thanks, Félix Sipma.
+ * Ssh.authorizedKey: Fix bug preventing it from working when the
+ authorized\_keys file does not yet exist.
+ * Removed Ssh.unauthorizedKey and made Ssh.authorizedKey revertable.
+ (API change)"""]] \ No newline at end of file
diff --git a/doc/news/version_2.17.0.mdwn b/doc/news/version_2.17.0.mdwn
new file mode 100644
index 00000000..4149dbab
--- /dev/null
+++ b/doc/news/version_2.17.0.mdwn
@@ -0,0 +1,30 @@
+propellor 2.17.0 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+ * Added initial support for FreeBSD.
+ Thanks, Evan Cofsky.
+ * Added Propellor.Property.ZFS.
+ Thanks, Evan Cofsky.
+ * Firewall: Reorganized Chain data type. (API change)
+ Thanks, Félix Sipma.
+ * Firewall: Separated Table and Target (API change)
+ Thanks, Félix Sipma.
+ * Ssh: change type of listenPort from Int to Port (API change)
+ Thanks, Félix Sipma.
+ * Firewall: add TCPFlag, Frequency, TCPSyn, ICMPTypeMatch, NatDestination
+ Thanks, Félix Sipma.
+ * Network: Filter out characters not allowed in interfaces.d files.
+ Thanks, Félix Sipma.
+ * Apt.upgrade: Run dpkg --configure -a first, to recover from
+ interrupted upgrades.
+ * Apt: Add safeupgrade.
+ * Force ssh, scp, and git commands to be run in the foreground.
+ Should fix intermittent hangs of propellor --spin.
+ * Avoid repeated re-building on systems such as FreeBSD where building
+ re-links the binary even when there are no changes.
+ * Locale.available: Run locale-gen, instead of dpkg-reconfigure locales,
+ which modified the locale.gen file and sometimes caused the property to
+ need to make changes every time.
+ * Speed up propellor's build of itself, by asking cabal to only build
+ the propellor-config binary and not all the libraries.
+ * Tor.named: Fix bug that sometimes caused the property to fail the first
+ time, though retrying succeeded."""]] \ No newline at end of file
diff --git a/doc/news/version_2.17.1.mdwn b/doc/news/version_2.17.1.mdwn
new file mode 100644
index 00000000..22727666
--- /dev/null
+++ b/doc/news/version_2.17.1.mdwn
@@ -0,0 +1,8 @@
+propellor 2.17.1 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+ * Avoid generating excessively long paths to the unix socket file
+ used for ssh connection caching. Mostly. Can still generate a too long
+ one if $HOME is longer than 60 bytes.
+ * Uwsgi: add ".ini" extension to app config files.
+ Files without extensions were ignored by uwsgi.
+ Thanks, Félix Sipma."""]] \ No newline at end of file
diff --git a/doc/news/version_2.17.2.mdwn b/doc/news/version_2.17.2.mdwn
new file mode 100644
index 00000000..3b11ec89
--- /dev/null
+++ b/doc/news/version_2.17.2.mdwn
@@ -0,0 +1,8 @@
+propellor 2.17.2 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+ * When new dependencies are added to propellor or the propellor config,
+ try harder to get them installed. In particular, this makes
+ propellor --spin work when the remote host needs to get dependencies
+ installed in order to build the updated config.
+ * Apt.update: Also run dpkg --configure -a here as apt for some reason
+ won't even update if dpkg was interrupted."""]] \ No newline at end of file
diff --git a/doc/news/version_3.0.4.mdwn b/doc/news/version_3.0.4.mdwn
new file mode 100644
index 00000000..f6e1eac2
--- /dev/null
+++ b/doc/news/version_3.0.4.mdwn
@@ -0,0 +1,8 @@
+propellor 3.0.4 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+ * Run letsencrypt with --noninteractive.
+ * Fix build with ghc 8.0.1.
+ Thanks, davean.
+ * Module added for the Borg backup system.
+ Thanks, Félix Sipma.
+ * Fix build with directory-1.2.6.2."""]] \ No newline at end of file
diff --git a/doc/posts.mdwn b/doc/posts.mdwn
new file mode 100644
index 00000000..77a2bf9f
--- /dev/null
+++ b/doc/posts.mdwn
@@ -0,0 +1,2 @@
+[[!inline pages="internal(feeds/*) and !*/Discussion" show=0 archive=yes
+title="propellor blog posts"]]
diff --git a/doc/security.mdwn b/doc/security.mdwn
index fb174cb7..b106b533 100644
--- a/doc/security.mdwn
+++ b/doc/security.mdwn
@@ -1,17 +1,18 @@
Propellor's security model is that the hosts it's used to deploy are
-untrusted, and that the central git repository server is untrusted too.
+untrusted, and that the central git repository server, if any,
+is untrusted too.
The only trusted machine is the laptop where you run `propellor --spin`
to connect to a remote host. And that one only because you have a ssh key
or login password to the host.
-Since the hosts propellor deploys are not trusted by the central git
-repository, they have to use git:// or http:// to pull from the central
-git repository, rather than ssh://.
+Since the hosts propellor deploys do not trust the central git repository,
+and it doesn't trust them, it's normal to use git:// or http:// to pull
+from the central git repository, rather than ssh://.
-So, to avoid a MITM attack, propellor checks that any commit it fetches
-from origin is gpg signed by a trusted gpg key, and refuses to deploy it
-otherwise.
+Since propellor doesn't trust the central git repository, it checks
+that any commit it fetches from it is gpg signed by a trusted gpg key,
+and refuses to deploy it otherwise.
That is only done when privdata/keyring.gpg exists. To set it up:
@@ -20,10 +21,10 @@ That is only done when privdata/keyring.gpg exists. To set it up:
In order to be secure from the beginning, when `propellor --spin` is used
to bootstrap propellor on a new host, it transfers the local git repositry
-to the remote host over ssh. After that, the remote host knows the
-gpg key, and will use it to verify git fetches.
+to the remote host over ssh. After that, the host knows the gpg key, and
+will use it to verify git fetches.
-Since the propoellor git repository is public, you can't store
+Since the propellor git repository is public, you can't store
in cleartext private data such as passwords, ssh private keys, etc.
Instead, `propellor --spin $host` looks for a
@@ -32,6 +33,6 @@ extracts the private data that the $host needs, and sends it to to the
$host using ssh. This lets a host know its own private data, without
seeing all the rest.
-To securely store private data, use: `propellor --set $field $context`
+To securely store private data, use: `propellor --set $field $context`
Propellor will tell you the details when you use a Property that needs
PrivData.
diff --git a/doc/security/comment_6_e5f2fdced08fb823efed35684110a840._comment b/doc/security/comment_6_e5f2fdced08fb823efed35684110a840._comment
new file mode 100644
index 00000000..8655f209
--- /dev/null
+++ b/doc/security/comment_6_e5f2fdced08fb823efed35684110a840._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2014-11-19T01:35:59Z"
+ content="""
+@Arnaud, see [[automated_spins]], including its documentation of a
+"deploy" remote, which can be used to configure the url that remote hosts
+should pull from.
+
+Also, propellor can be used now without any centralized repository.
+"""]]
diff --git a/doc/security/comment_7_ebbb6f3617c879715a35900a07ea1909._comment b/doc/security/comment_7_ebbb6f3617c879715a35900a07ea1909._comment
new file mode 100644
index 00000000..e9d20642
--- /dev/null
+++ b/doc/security/comment_7_ebbb6f3617c879715a35900a07ea1909._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawkgUir7k_amh9RFp4D3QutX1fGh_nd7ko4"
+ nickname="Philipp"
+ subject="Passwords in PrivData"
+ date="2014-12-13T18:25:23Z"
+ content="""
+I wonder if there could be a shortcut in PrivData handling that hashes the input with crypt() instead of passing it raw to a machine. For instance passwords are stored in plain on the target machines, while this is not required to set the password in shadow: the hash would suffice. I think this page should at least spell out that fact.
+"""]]
diff --git a/doc/security/comment_8_311b80b491ecd018c73631044450294a._comment b/doc/security/comment_8_311b80b491ecd018c73631044450294a._comment
new file mode 100644
index 00000000..8382cf99
--- /dev/null
+++ b/doc/security/comment_8_311b80b491ecd018c73631044450294a._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 8"""
+ date="2014-12-15T15:56:45Z"
+ content="""
+@Philipp, indeed: It's important to realize that all data entered into
+the privdata with `propellor --set` is deployed in cleartext to the
+machines that use it. Kept in a directory only root can read, but still,
+important to bear in mind.
+
+I've added the ability to use `CryptPassword` instead of `Password`
+to `User.hasPassword` and `User.hasSomePassword`.
+"""]]
diff --git a/doc/templates/bare.tmpl b/doc/templates/bare.tmpl
new file mode 100644
index 00000000..2d476b71
--- /dev/null
+++ b/doc/templates/bare.tmpl
@@ -0,0 +1 @@
+<TMPL_VAR CONTENT>
diff --git a/doc/templates/todolist.tmpl b/doc/templates/todolist.tmpl
new file mode 100644
index 00000000..a5d93e9b
--- /dev/null
+++ b/doc/templates/todolist.tmpl
@@ -0,0 +1,25 @@
+<div class="archivepage">
+<TMPL_IF PERMALINK>
+<a href="<TMPL_VAR PERMALINK>"><TMPL_VAR TITLE></a>
+<TMPL_ELSE>
+<a href="<TMPL_VAR PAGEURL>"><TMPL_VAR TITLE></a>
+</TMPL_IF>
+<TMPL_IF TAGS>
+<TMPL_LOOP TAGS>
+ [<TMPL_VAR LINK>]
+</TMPL_LOOP>
+</TMPL_IF>
+<br />
+<span class="archivepagedate">
+Posted <TMPL_VAR CTIME>
+<TMPL_IF AUTHOR>
+by <span class="author">
+<TMPL_IF AUTHORURL>
+<a href="<TMPL_VAR AUTHORURL>"><TMPL_VAR AUTHOR></a>
+<TMPL_ELSE>
+<TMPL_VAR AUTHOR>
+</TMPL_IF>
+</span>
+</TMPL_IF>
+</span>
+</div>
diff --git a/doc/todo.mdwn b/doc/todo.mdwn
index 06e3db4f..f0ac83f7 100644
--- a/doc/todo.mdwn
+++ b/doc/todo.mdwn
@@ -1,6 +1,13 @@
-This is propellor's todo list. Link items to [[todo/done]] when done.
+This is propellor's todo list.
+
+Unclaimed items are probably not being worked on. But anyone can
+[[contribute|contributing]]!
+To claim an item you plan to work on, edit it and add: \[[!tag user/yourname]]
+
+Link items to [[todo/done]] when done.
See also: [Debian BTS](http://bugs.debian.org/propellor).
[[!inline pages="./todo/* and !./todo/done and !link(done)
-and !*/Discussion" actions=yes postform=yes show=0 archive=yes]]
+and !*/Discussion" actions=yes postform=yes show=0 archive=yes
+template=todolist]]
diff --git a/doc/todo/Bug_in_Property.Ssh.authorizedKey.mdwn b/doc/todo/Bug_in_Property.Ssh.authorizedKey.mdwn
new file mode 100644
index 00000000..7a59fc20
--- /dev/null
+++ b/doc/todo/Bug_in_Property.Ssh.authorizedKey.mdwn
@@ -0,0 +1,8 @@
+If Ssh.authorizedKey in propellor 2.0.0 is used to create .ssh/authorized_keys for
+a user other than root, it will be owned by root:root and won't
+work for the user. Adding a key to an existing authorized_keys
+file doesn't change its ownership and therefore works fine.
+
+-- weinzwang
+
+> Thanks, [[fixed|done]] this and will make a release.
diff --git a/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties.mdwn b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties.mdwn
new file mode 100644
index 00000000..57cbc343
--- /dev/null
+++ b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties.mdwn
@@ -0,0 +1,25 @@
+# `File.containsConfPair` property
+
+A property to set `key = value` pairs under particular `[sections]` in config files. For example, in stock Debian Jessie `/etc/lightdm/lightdm.conf` contains the lines
+
+ [SeatDefaults]
+ #autologin-user=
+
+With the property
+
+ "/etc/lightdm/lightdm.conf" `File.containsConfPair` ("SeatDefaults", "autologin-user", "swhitton")
+
+this will get set to
+
+ [SeatDefaults]
+ autologin-user=swhitton
+
+# `LightDM.autoLogin` property
+
+An application of `File.containsConfPair` to edit `/etc/lightdm/lightdm.conf` to enable autologin for a specified user: a property encapsulating the above example.
+
+# Patches
+
+Please see the two commits in branch `confpairs` in the repo at `git@github.com:spwhitton/propellor.git`.
+
+> [[merged|done]] --[[Joey]]
diff --git a/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_1_c8240ba3abf5cf458eba8ed7e31eaccf._comment b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_1_c8240ba3abf5cf458eba8ed7e31eaccf._comment
new file mode 100644
index 00000000..a5a2b80c
--- /dev/null
+++ b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_1_c8240ba3abf5cf458eba8ed7e31eaccf._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-08-04T14:23:33Z"
+ content="""
+Thanks for submitting these patches!
+
+Looking at `containsConfPair`, it assumes an ini-style file,
+so is a little misplaced in Property.File. which is otherwise about generic
+text files.
+
+So, it would probably make sense to move it to a new Property.IniFile
+module.
+
+However, [[forum/parsing_a_config_file]] recently pointed out that
+the tor config file has a similar need. It's not ini format, but
+shares the same basic idea of a "section" line which is followed by
+lines setting things specific to that section.
+
+So, it would be great if `containsConfPair` could be generalized to also
+cover that tor config file use case. I think this would be pretty easy;
+just make it take one string containing the whole section line (including
+square brackets for ini file, or whatever for tor config file), and a
+second string containing the whole setting line.
+"""]]
diff --git a/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_2_9303138a3be2fb639498737afe60b87d._comment b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_2_9303138a3be2fb639498737afe60b87d._comment
new file mode 100644
index 00000000..7b01dd71
--- /dev/null
+++ b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_2_9303138a3be2fb639498737afe60b87d._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 2"
+ date="2015-08-05T21:29:04Z"
+ content="""
+Thanks for the input!
+
+I agree that generalising to lines under sections is a good idea, but I don't think it can be as simple as a property taking the full section header and the full settings line. That's because there is a need to update the values of keys under sections: in the example LightDM case, the line `autologin-user=someone` must *replace* any `autologin-user=someone_else`. So the function needs to know the key, not just the whole line.
+
+So to generalise containsConfPair, it might take a section header, key, value and a specification of what kind of config file it is. That specification would be a type containing the comment character, the formatting of section headers and the use of spaces, colons or equals signs between keys and values. What do you think to this?
+"""]]
diff --git a/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_3_92c583f883fae2b447c1598356efade2._comment b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_3_92c583f883fae2b447c1598356efade2._comment
new file mode 100644
index 00000000..a45bc921
--- /dev/null
+++ b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_3_92c583f883fae2b447c1598356efade2._comment
@@ -0,0 +1,41 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-08-06T14:54:14Z"
+ content="""
+I'd suggest making it take some helper functions.
+
+Something like these:
+
+ type SectionStart = String -> Bool -- ^ find the line that is the start of the wanted section (eg, == "<Foo>")
+ type SectionEnd = String -> Bool -- ^ find a line that is within the section, but that indicates the end of the section (eg == "</Foo>")
+ type SectionPast = String -> Bool -- ^ find a line that indicates we are past the section (eg, a new section header)
+ type AdjustSection = [String] -> [String] -- ^ run on all lines in the section, including the SectionStart line and any SectionEnd line; can add/delete/modify lines, or even delete entire section
+ type InsertSection = [String] -> [String] -- ^ if SectionStart does not find the section in the file, this is used to insert the section somewhere within it
+
+ adjustSection :: SectionStart -> SectionEnd -> AdjustSection -> InsertSection -> FilePath -> Property
+
+Which seems sufficiently generic; it can even be used to delete entire sections!
+
+Let's see..
+
+ iniHeader header = '[':header++"]"
+
+ adjustIniSection :: String -> AdjustSection -> InsertSection -> Property
+ adjustIniSection header = adjustSection
+ (== iniHeader header)
+ (const False)
+ ("[" `isPrefixOf`)
+
+ containsConfPair header key value = adjustIniSection header
+ go
+ (++ [confheader, confline]) -- add missing section at end
+ where
+ confheader = iniHeader header
+ confline = key ++ "=" ++ value
+ go ls = undefined -- TODO find key= line and change it, or add confline
+
+ removeSection header = adjustIniSection header
+ (const []) -- remove all lines of section
+ id -- add no lines if section is missing
+"""]]
diff --git a/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_4_2049a1ce601ba77f4139f844d0fd91b2._comment b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_4_2049a1ce601ba77f4139f844d0fd91b2._comment
new file mode 100644
index 00000000..f4e0921f
--- /dev/null
+++ b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_4_2049a1ce601ba77f4139f844d0fd91b2._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 4"
+ date="2015-08-17T00:57:54Z"
+ content="""
+Thanks for the ideas. I've implemented them as a new commit to my confpairs branch. Please take a look.
+
+Two points:
+
+1. I dropped the SectionEnd helper function. My implementation of adjustSection didn't need it and I couldn't think up a case where it would be needed.
+
+2. I'm using a tuple `(section, key, value)` as the second argument to `ConfFile.containsIniPair`, rather than just using four arguments as you suggested. If `ConfFile.containsIniPair` takes four arguments, then it cannot be used infix when attached to other properties with the `&` operator, without using extra brackets.
+"""]]
diff --git a/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_5_4caff287eb767d481bb7ef87e62c508b._comment b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_5_4caff287eb767d481bb7ef87e62c508b._comment
new file mode 100644
index 00000000..40f14ec2
--- /dev/null
+++ b/doc/todo/File.containsConfPair___38___LightDM.autoLogin_properties/comment_5_4caff287eb767d481bb7ef87e62c508b._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2015-08-20T14:37:43Z"
+ content="""
+And merged, thanks.
+
+The SectionEnd would be useful for eg, bind-style or apache-style config
+files. However, those probably need a better parser than this one anyway.
+"""]]
diff --git a/doc/todo/Fix___40__-__62__-__41___signature_in_Propellor.Types.Container.mdwn b/doc/todo/Fix___40__-__62__-__41___signature_in_Propellor.Types.Container.mdwn
new file mode 100644
index 00000000..58c9b5ca
--- /dev/null
+++ b/doc/todo/Fix___40__-__62__-__41___signature_in_Propellor.Types.Container.mdwn
@@ -0,0 +1,4 @@
+Please merge this commit
+https://github.com/miniBill/propellor/commit/0d9cd127c3448998aa4e4d20a8ce4083ee4b4362
+
+> [[done]], thanks --[[Joey]]
diff --git a/doc/todo/HostingProvider_for_AWS.mdwn b/doc/todo/HostingProvider_for_AWS.mdwn
new file mode 100644
index 00000000..fc381afe
--- /dev/null
+++ b/doc/todo/HostingProvider_for_AWS.mdwn
@@ -0,0 +1 @@
+I'd really love to be able to use propellor to manage my AWS services.
diff --git a/doc/todo/HostingProvider_for_AWS/comment_1_9db50a3f4fef8e10261e3e29dbd90e73._comment b/doc/todo/HostingProvider_for_AWS/comment_1_9db50a3f4fef8e10261e3e29dbd90e73._comment
new file mode 100644
index 00000000..71ded884
--- /dev/null
+++ b/doc/todo/HostingProvider_for_AWS/comment_1_9db50a3f4fef8e10261e3e29dbd90e73._comment
@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-05-14T16:19:00Z"
+ content="""
+So there's something here that propellor doesn't yet have a concept of,
+and that's spinning up a VM. Propellor can deploy itself to an existing VM
+pretty well, but getting the VM running isn't something it tries to do.
+
+I imagine that --spin could be extended to support this though.
+Make a Property like `vm AWS`, which tells propellor that the host
+is a VM, and that the VM is hosted on AWS. Then when you run propellor
+--spin, it could set up the VM if it doesn't exist yet.
+
+I don't use AWS currently, so don't have plans to work on this myself,
+although I think it would be a great direction to move in. Happy to help
+with advice, code review, etc.
+
+<http://hackage.haskell.org/package/aws>
+or <http://hackage.haskell.org/package/amazonka>
+are good haskell libraries for working with AWS.
+"""]]
diff --git a/doc/todo/HostingProvider_for_AWS/comment_2_bc4fdd34c10aa3d3846818baf7b07dc7._comment b/doc/todo/HostingProvider_for_AWS/comment_2_bc4fdd34c10aa3d3846818baf7b07dc7._comment
new file mode 100644
index 00000000..38037bbe
--- /dev/null
+++ b/doc/todo/HostingProvider_for_AWS/comment_2_bc4fdd34c10aa3d3846818baf7b07dc7._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="evan@0e4cded17eab71af967a38b123fbc211cf215421"
+ nickname="evan"
+ subject="AWS Instances"
+ date="2016-03-08T02:53:16Z"
+ content="""
+It just so happens I have a use case for this, and it'll also involve specifics for VPCs, Encryption at Rest, public vs private subnets, and a whole lot of other compliance stuff that would be great to be able to express as properties. I'll start in on something probably shortly. It's either that or try and make Chef compliant, and that's literally completely unappealing.
+"""]]
diff --git a/doc/todo/HostingProvider_for_AWS/comment_3_062f85b8358930759b498b613c5599cd._comment b/doc/todo/HostingProvider_for_AWS/comment_3_062f85b8358930759b498b613c5599cd._comment
new file mode 100644
index 00000000..db7bc2f0
--- /dev/null
+++ b/doc/todo/HostingProvider_for_AWS/comment_3_062f85b8358930759b498b613c5599cd._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="evan@0e4cded17eab71af967a38b123fbc211cf215421"
+ nickname="evan"
+ subject="Container Service"
+ date="2016-03-08T02:54:27Z"
+ content="""
+I forgot to mention that as well. Scheduling Docker containers with the container service on dedicated instances with AWS.
+
+I have needs, and a lot of stubbornness.
+"""]]
diff --git a/doc/todo/HostingProvider_for_AWS/comment_4_7fb00a5629b390c658fcf3569d49d2c2._comment b/doc/todo/HostingProvider_for_AWS/comment_4_7fb00a5629b390c658fcf3569d49d2c2._comment
new file mode 100644
index 00000000..1a37a08c
--- /dev/null
+++ b/doc/todo/HostingProvider_for_AWS/comment_4_7fb00a5629b390c658fcf3569d49d2c2._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-03-08T03:40:07Z"
+ content="""
+Well Evan, I know you already have been in the guts of the spin code, so I
+know you can manage it! Looking forward to this.
+"""]]
diff --git a/doc/todo/HostingProvider_for_AWS/comment_5_ace17433647f7b2adbce27261cf4cd33._comment b/doc/todo/HostingProvider_for_AWS/comment_5_ace17433647f7b2adbce27261cf4cd33._comment
new file mode 100644
index 00000000..da9324ca
--- /dev/null
+++ b/doc/todo/HostingProvider_for_AWS/comment_5_ace17433647f7b2adbce27261cf4cd33._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="evan@0e4cded17eab71af967a38b123fbc211cf215421"
+ nickname="evan"
+ subject="Amazonka"
+ date="2016-03-10T03:24:47Z"
+ content="""
+[Amazonka](http://brendanhay.nz/amazonka-doc/amazonka-ec2/index.html) is really thorough, and I think I'm going to start writing some properties to spin up some things tomorrow. I wrote some PKI stuff today for work so we can start launching things without SSH open to the world, and this is definitely a good next step.
+
+I've already got a hand-mashed set of subnets I'm really itching to automate.
+
+
+
+Thanks
+"""]]
diff --git a/doc/todo/HostingProvider_for_AWS/comment_6_be3608729f362cdf5fc0a338c4a07f67._comment b/doc/todo/HostingProvider_for_AWS/comment_6_be3608729f362cdf5fc0a338c4a07f67._comment
new file mode 100644
index 00000000..ceaecaed
--- /dev/null
+++ b/doc/todo/HostingProvider_for_AWS/comment_6_be3608729f362cdf5fc0a338c4a07f67._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="evan@0e4cded17eab71af967a38b123fbc211cf215421"
+ nickname="evan"
+ subject="In Fact Amazonka is Fairly Epic"
+ date="2016-03-11T14:14:51Z"
+ content="""
+I'm going to start working with it outside Propellor for a bit to configure our infrastructure, then I think we can really have a good sense of what we can do to start moving bits back into Propellor. To give an idea of just how much is going on, even just building amazonka-ec2 takes around 30 minutes on my laptop. A lot of it is (rightly-so) auto-generated from the AWS API descriptions, and it relies heavily on lenses. One of my goals with my current work is getting our AWS infrastructure built using Amazonka, and with a similar model as Propellor, and I think that'll ultimately be something we'll be able to merge (with a lot of merging effort of course).
+"""]]
diff --git a/doc/todo/HostingProvider_for_AWS/comment_7_a77278f07bc0047d1f25c3d6c294b475._comment b/doc/todo/HostingProvider_for_AWS/comment_7_a77278f07bc0047d1f25c3d6c294b475._comment
new file mode 100644
index 00000000..1d196a51
--- /dev/null
+++ b/doc/todo/HostingProvider_for_AWS/comment_7_a77278f07bc0047d1f25c3d6c294b475._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2016-03-15T16:34:22Z"
+ content="""
+<https://github.com/joeyh/propellor/pull/12>
+"""]]
diff --git a/doc/todo/License_in_propellor.cabal.mdwn b/doc/todo/License_in_propellor.cabal.mdwn
new file mode 100644
index 00000000..90a0e8f8
--- /dev/null
+++ b/doc/todo/License_in_propellor.cabal.mdwn
@@ -0,0 +1,3 @@
+`propellor.cabal` claims that propellor is licensed under the 3-clause BSD license. `debian/copyright` says it's licensed under the 2-clause BSD license. Which is correct? An ftp-master noticed. Thanks. --spwhitton
+
+> [[fixed|done]] --[[Joey]]
diff --git a/doc/todo/License_in_propellor.cabal/comment_1_3009093e2ab7bcf9e60555da71796a63._comment b/doc/todo/License_in_propellor.cabal/comment_1_3009093e2ab7bcf9e60555da71796a63._comment
new file mode 100644
index 00000000..3ea7af89
--- /dev/null
+++ b/doc/todo/License_in_propellor.cabal/comment_1_3009093e2ab7bcf9e60555da71796a63._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-10T16:06:12Z"
+ content="""
+It's 2-clause, see LICENSE.
+
+Cabal file license fields are too restricted syntax to be more than
+a general indication of license in general I think.
+"""]]
diff --git a/doc/todo/Manage_DNS_with_Route53.mdwn b/doc/todo/Manage_DNS_with_Route53.mdwn
new file mode 100644
index 00000000..b35a37cb
--- /dev/null
+++ b/doc/todo/Manage_DNS_with_Route53.mdwn
@@ -0,0 +1 @@
+I currently use Route53 to manage the DNS for my service. I'd really like to use Propellor to take care of that for me.
diff --git a/doc/todo/Manage_DNS_with_Route53/comment_1_dfa93678644b72781afda4fdc9d0da31._comment b/doc/todo/Manage_DNS_with_Route53/comment_1_dfa93678644b72781afda4fdc9d0da31._comment
new file mode 100644
index 00000000..8836beaa
--- /dev/null
+++ b/doc/todo/Manage_DNS_with_Route53/comment_1_dfa93678644b72781afda4fdc9d0da31._comment
@@ -0,0 +1,21 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-05-14T16:18:37Z"
+ content="""
+I think this would be great. Patches accepted.
+
+If I were going to implement this, I'd use
+<http://hackage.haskell.org/package/amazonka-route53>
+to write the propellor Property.
+
+A question is, what host would the Property be attached to?
+One way to do it would be to make the property be called something like
+`route53Controller`. So then you pick a host, or hosts, and give them this
+property for a domain, and those hosts then take care of making the
+necessary API calls to route53. Presumably some API keys will be needed
+on those hosts, which can be provided via the privdata.
+
+I'm happy to offer advice on implementation, but don't plan to code this up
+myself, as I'm happily self-hosting my DNS servers.
+"""]]
diff --git a/doc/todo/Manage_DNS_with_Route53/comment_2_a6c1ace47d5387d0b1559266ca124525._comment b/doc/todo/Manage_DNS_with_Route53/comment_2_a6c1ace47d5387d0b1559266ca124525._comment
new file mode 100644
index 00000000..9b5150bf
--- /dev/null
+++ b/doc/todo/Manage_DNS_with_Route53/comment_2_a6c1ace47d5387d0b1559266ca124525._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://launchpad.net/~jml"
+ nickname="jml"
+ subject="comment 2"
+ date="2015-05-15T08:53:34Z"
+ content="""
+Glad you think so. I had a very quick poke around and also discovered [aws-ec2](https://hackage.haskell.org/package/aws-ec2) as well as the amazonka package. Any particular reason for preferring amazonka to aws-ec2?
+"""]]
diff --git a/doc/todo/Manage_DNS_with_Route53/comment_3_a521a1b875526d8b65e76f11ed367a36._comment b/doc/todo/Manage_DNS_with_Route53/comment_3_a521a1b875526d8b65e76f11ed367a36._comment
new file mode 100644
index 00000000..00bb6b04
--- /dev/null
+++ b/doc/todo/Manage_DNS_with_Route53/comment_3_a521a1b875526d8b65e76f11ed367a36._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 3"
+ date="2015-06-08T01:22:14Z"
+ content="""
+aws-ec2 doesn't seem to support Route53, unless I'm missing something.
+"""]]
diff --git a/doc/todo/OpenVPN___40__PR___35__13__41__.mdwn b/doc/todo/OpenVPN___40__PR___35__13__41__.mdwn
new file mode 100644
index 00000000..3847b31c
--- /dev/null
+++ b/doc/todo/OpenVPN___40__PR___35__13__41__.mdwn
@@ -0,0 +1,20 @@
+> Is the ghc ppa needed past 12.04LTS? Past that version, they seem to
+> have ghc 7.6.3 or newer, which is the current target version as it's the
+> version in debian stable. If only specific ubuntu versions need the ghc
+> ppa it would be best to avoid using it on newer ones.
+
+Oh! I hadn't realized 7.6.3 was the target, so I upgraded to 7.10.3 (which is what I've been using for things). I can definitely try a spin without it. I can't remember why I thought 7.6.3 was failing there but I'll definitely dig into it.
+
+> Even type aliases
+> would be an improvement but probably newtypes or ADTs would improve on
+> it. Also there may be some overlap with typees in Propellor.Property.Firewall
+
+Oh yes, definitely. I'll take a pass at that too, and dig into Firewall to see what's there.
+
+> Isn't Property HasInfo a shorter way to write that? I'm somewhat
+> surprised you arrived at the partially applied type family there; ghc
+> normally tells you the simplified type.
+
+ CombinedType (Property NoInfo) (Property HasInfo)
+
+That's an excellent question. I think ultimately I tried a type hole to find out what I was missing, and that's what it came up with, but it also might be differences in ghc versions I stumbled into. I'll give it a try with 7.6.3. I'm using Trusty 14.04.4 for the project this is for.
diff --git a/doc/todo/Propellor.Property.Ssh:_it_should_be_possible_to_call_permitRootLogin_with___34__forced-commands-only__34___and___34__without-password__34__.mdwn b/doc/todo/Propellor.Property.Ssh:_it_should_be_possible_to_call_permitRootLogin_with___34__forced-commands-only__34___and___34__without-password__34__.mdwn
new file mode 100644
index 00000000..f02ff328
--- /dev/null
+++ b/doc/todo/Propellor.Property.Ssh:_it_should_be_possible_to_call_permitRootLogin_with___34__forced-commands-only__34___and___34__without-password__34__.mdwn
@@ -0,0 +1,5 @@
+It should be possible to call Propellor.Property.Ssh.permitRootLogin with "forced-commands-only" and "without-password", in addition to "True" or "False". It requires to change the type of the function (and maybe to create a new datatype?)...
+
+ permitRootLogin :: Bool -> Property NoInfo
+
+> [[done]] --[[Joey]]
diff --git a/doc/todo/Push_2.4.0_to_Hackage.mdwn b/doc/todo/Push_2.4.0_to_Hackage.mdwn
new file mode 100644
index 00000000..a176f416
--- /dev/null
+++ b/doc/todo/Push_2.4.0_to_Hackage.mdwn
@@ -0,0 +1,4 @@
+https://propellor.branchable.com/news/version_2.4.0/ says that version 2.4.0, but as of today, 2.3.0 is the latest version on Hackage: http://hackage.haskell.org/package/propellor
+
+> Seems the upload must have failed and I didn't notice. re-uploaded;
+> [[done]] --[[Joey]]
diff --git a/doc/todo/RevertableProperty_with_NoInfo.mdwn b/doc/todo/RevertableProperty_with_NoInfo.mdwn
new file mode 100644
index 00000000..1aea0a04
--- /dev/null
+++ b/doc/todo/RevertableProperty_with_NoInfo.mdwn
@@ -0,0 +1,48 @@
+Currently, a RevertableProperty's Properties always both HasInfo. This
+means that if a Property NoInfo is updated to be a RevertableProperty, and
+someplace called ensureProperty on it, that will refuse to compile.
+
+The workaround is generally to export the original NoInfo property under
+a different name, so it can still be used with ensureProperty.
+
+This could be fixed:
+
+ data RevertableProperty i1 i2 where
+ RProp :: Property i1 -> Property i2 -> RevertableProperty i1 i2
+
+However, needing to write "RevertableProperty HasInfo NoInfo" is quite
+a mouthful!
+
+Since only 2 places in the propellor source code currently need to deal
+with this, it doesn't currently seem worth making the change, unless a less
+intrusive way can be found.
+
+> Hmm.. I'm not sure what I meant by that last paragraph, but I'm sure
+> this wart is annoying in more than 2 places by now. --[[Joey]]
+
+> Would be nice to instead have `RevertableProperty i`, where the i was inherited
+> from the currently active property. This would be less of a mouthful,
+> and models the info transfer correctly. Ie, if I have a
+> RevertableProperty that includes dns settings on its setup side,
+> reverting it means dropping those dns settings, so the result is NoInfo.
+
+> Unfortunately, when I tried to implement this, the types prevented it.
+> In particular, anything to do with the second property in a
+> `RevertableProperty i` is a problem because we don't know what
+> type of Property it is. For example:
+
+ data RevertableProperty i where
+ RIProperty :: Property HasInfo -> Property i -> RevertableProperty HasInfo
+ RSProperty :: Property NoInfo -> Property i -> RevertableProperty NoInfo
+
+ activeProperty :: RevertableProperty i -> Property i
+ activeProperty (RIProperty p _) = p
+ activeProperty (RSProperty p _) = p
+
+ inactiveProperty :: RevertableProperty i -> Property x
+
+> The x is unknown and cannot be deduced from the available types.
+>
+> What could be done, instead, is to make a `RevertableProperty i` specify
+> the info of both its sides. While this doesn't perfectly model
+> the info propigation, the types work. [[done]] --[[Joey]]
diff --git a/doc/todo/SDN_Configuration.mdwn b/doc/todo/SDN_Configuration.mdwn
new file mode 100644
index 00000000..f87075f1
--- /dev/null
+++ b/doc/todo/SDN_Configuration.mdwn
@@ -0,0 +1 @@
+I think this may be a bit more of a back-burner thing, but with virtual networking and software-defined networking, like what OpenStack, AWS VPC, and others have, adding another type at the same level as Host currently, but for networks might be an interesting thing to consider ways of doing.
diff --git a/doc/todo/User.hasDesktopGroups:_debian-tor_group_doesn__39__t_necessarily_exist.mdwn b/doc/todo/User.hasDesktopGroups:_debian-tor_group_doesn__39__t_necessarily_exist.mdwn
new file mode 100644
index 00000000..b6e1ec20
--- /dev/null
+++ b/doc/todo/User.hasDesktopGroups:_debian-tor_group_doesn__39__t_necessarily_exist.mdwn
@@ -0,0 +1,10 @@
+The new `User.hasDesktopGroups` tries to add a user to the group `debian-tor` which fails if this group does not exist.
+
+What package creates this group? If someone could let me know that, I will patch `User.hasDesktopGroups` to only try to add a user to `debian-tor` if `Apt.isInstalled "blah"` is true.
+
+Or perhaps Joey added this group because this group exists by default on Debian Unstable. If so then a check can be inserted for that.
+
+--[[spwhitton|https://spwhitton.name/]]
+
+> Noticed that too and made it only add the user to existant groups, which
+> is the same approach user-setup uses. [[done]] --[[Joey]]
diff --git a/doc/todo/Wishlist:_User.hasLoginShell.mdwn b/doc/todo/Wishlist:_User.hasLoginShell.mdwn
new file mode 100644
index 00000000..cf8aa73c
--- /dev/null
+++ b/doc/todo/Wishlist:_User.hasLoginShell.mdwn
@@ -0,0 +1,9 @@
+As far as I can tell there is no easy way to set a user's
+login shell. A Property User.hasLoginShell, which ensures
+that a user has a specified login shell and that said shell
+is in /etc/shells would be really helpful. Sadly, I lack the
+skills to put this together myself :(
+
+-- weinzwang
+
+> patched in and so [[done]] --[[Joey]]
diff --git a/doc/todo/Wishlist:_User.hasLoginShell/comment_1_c02e8783b91c3c0326bf1b317be4694f._comment b/doc/todo/Wishlist:_User.hasLoginShell/comment_1_c02e8783b91c3c0326bf1b317be4694f._comment
new file mode 100644
index 00000000..91ca404e
--- /dev/null
+++ b/doc/todo/Wishlist:_User.hasLoginShell/comment_1_c02e8783b91c3c0326bf1b317be4694f._comment
@@ -0,0 +1,58 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-04-19T16:07:24Z"
+ content="""
+Propellor makes it very easy to put together a property like this.
+
+Let's start with a property that combines the two properties you mentioned:
+
+ hasLoginShell :: UserName -> FilePath -> Property
+ hasLoginShell user shell = shellSetTo user shell `requires` shellEnabled shell
+
+The shellEnabled property can be easily written using propellor's file
+manipulation properties.
+
+ -- Need to add an import to the top of the source file.
+ import qualified Propellor.Property.File as File
+
+ shellEnabled :: FilePath -> Property
+ shellEnabled shell = "/etc/shells" `File.containsLine` shell
+
+And then, we want to actually change the user's shell. The `chsh(1)`
+program can do that, so we can simply tell propellor the command line to
+run:
+
+ shellSetTo :: UserName -> FilePath -> Property
+ shellSetTo user shell = cmdProperty "chsh" ["--shell", shell, user]
+:
+The only remaining problem with this is that shellSetTo runs chsh every
+time, and propellor will always display that it's made a change each time
+it runs, even when it didn't really do much. Now, there's an easy way to
+avoid that problem, we could just tell propellor to assume it's not made
+any change:
+
+ shellSetTo :: UserName -> FilePath -> Property
+ shellSetTo user shell = cmdProperty "chsh" ["--shell", shell, user]
+ `assume` NoChange
+
+But, it's not much harder to do this right. Let's make the property
+check if the user's shell is already set to the desired value and avoid
+doing anything in that case.
+
+ shellSetTo :: UserName -> FilePath -> Property
+ shellSetTo user shell = check needchangeshell $
+ cmdProperty "chsh" ["--shell", shell, user]
+ where
+ needchangeshell = do
+ currshell <- userShell <$> getUserEntryForName user
+ return (currshell /= shell)
+
+And that will probably all work, although I've not tested it. You might
+want to throw in some uses of `describe` to give the new properties
+more useful descriptions.
+
+I hope this has been helpful as an explanation of how to add properties to
+Propellor, and if you get these properties to work, a patch adding them
+to Propellor.User would be happily merged.
+"""]]
diff --git a/doc/todo/bytes_in_privData__63__.mdwn b/doc/todo/bytes_in_privData__63__.mdwn
new file mode 100644
index 00000000..27297fd5
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__.mdwn
@@ -0,0 +1,17 @@
+It seems like I can't set the content of a PrivFile to arbitrary bytes.
+
+ $ propellor --set 'PrivFile "mysecret.key"' 'mycontext' < ~/mysecret.key
+ find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$' | xargs hothasktags | perl -ne 'print; s/Propellor\.Property\.//; print' | sort > tags 2>/dev/null || true
+ cabal build
+ Building propellor-2.2.1...
+ Preprocessing library propellor-2.2.1...
+ In-place registering propellor-2.2.1...
+ Preprocessing executable 'propellor' for propellor-2.2.1...
+ Preprocessing executable 'propellor-config' for propellor-2.2.1...
+ [70 of 70] Compiling Main ( src/config.hs, dist/build/propellor-config/propellor-config-tmp/Main.o )
+ Linking dist/build/propellor-config/propellor-config ...
+ ln -sf dist/build/propellor-config/propellor-config propellor
+
+
+ Enter private data on stdin; ctrl-D when done:
+ propellor: <stdin>: hGetContents: invalid argument (invalid byte sequence)
diff --git a/doc/todo/bytes_in_privData__63__/comment_1_42c107179b091f74ef55aff1fc240c5e._comment b/doc/todo/bytes_in_privData__63__/comment_1_42c107179b091f74ef55aff1fc240c5e._comment
new file mode 100644
index 00000000..5c1508fd
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__/comment_1_42c107179b091f74ef55aff1fc240c5e._comment
@@ -0,0 +1,19 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-04-20T01:04:26Z"
+ content="""
+I imagine that adding `fileEncoding stdin` to setPrivData will fix
+this crash, but I'd expect there are also other problems with encodings
+for privdata that haskell doesn't like. Similar fixes would probably
+be needed in several other places.
+
+Probably cleaner and better to convert
+`PrivData` from a String to a ByteString, and so avoid encodings
+being applied to it. I think this could be done without changing the
+file format; the privdata file uses Read/Show for serialization,
+and happily ByteString uses the same Read/Show format as String does.
+
+So, changing the type and following the compile errors should get you
+there, I think!
+"""]]
diff --git a/doc/todo/bytes_in_privData__63__/comment_2_60f577b476adc6ee1e4f18e11843df90._comment b/doc/todo/bytes_in_privData__63__/comment_2_60f577b476adc6ee1e4f18e11843df90._comment
new file mode 100644
index 00000000..10ff956a
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__/comment_2_60f577b476adc6ee1e4f18e11843df90._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 2"
+ date="2015-04-21T12:59:42Z"
+ content="""
+Would you accept a patch converting PrivData from String to ByteString?
+"""]]
diff --git a/doc/todo/bytes_in_privData__63__/comment_3_55f34128de77b7947d32fac71071e033._comment b/doc/todo/bytes_in_privData__63__/comment_3_55f34128de77b7947d32fac71071e033._comment
new file mode 100644
index 00000000..a1c7f62f
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__/comment_3_55f34128de77b7947d32fac71071e033._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-04-21T16:52:06Z"
+ content="""
+Absolutely. Thought that went w/o saying. ;)
+"""]]
diff --git a/doc/todo/bytes_in_privData__63__/comment_4_f34a8f82c7bce7224e4edc59410c741f._comment b/doc/todo/bytes_in_privData__63__/comment_4_f34a8f82c7bce7224e4edc59410c741f._comment
new file mode 100644
index 00000000..bd7a0618
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__/comment_4_f34a8f82c7bce7224e4edc59410c741f._comment
@@ -0,0 +1,19 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 4"
+ date="2015-04-23T09:21:07Z"
+ content="""
+I tried to do the conversion, but then it started a kind of chain reaction... (PrivData=ByteString to writeFileProtected to Line=ByteString to ... to readProcess to ...) Should I use FilePath=String? ... To be honest, the patch became a lot bigger that what I am comfortable with. :-)
+
+I guess you should have a look at it...
+
+At least, I think there is a type bug in Propellor.Property.File:
+
+ hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (String -> FilePath -> IO ()) -> s -> FilePath -> c -> Property HasInfo
+
+but it should be
+
+ hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property HasInfo
+
+(it is hidden by FilePath = String)
+"""]]
diff --git a/doc/todo/bytes_in_privData__63__/comment_5_f4db6ffad054feb7eb299708fcd7d05c._comment b/doc/todo/bytes_in_privData__63__/comment_5_f4db6ffad054feb7eb299708fcd7d05c._comment
new file mode 100644
index 00000000..45c97b97
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__/comment_5_f4db6ffad054feb7eb299708fcd7d05c._comment
@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2015-04-23T13:25:50Z"
+ content="""
+Can you put the patch up somewhere? I'll take a look. Might see a way to
+short-curcuit the bytestring before everything becomes one..
+
+One way might be:
+
+ writeFileProtected :: FileContent content => FilePath -> content -> IO ()
+
+Which would also at least partly avoid foot-shooting over which parameter is which.
+(Fixed that type signature.)
+"""]]
diff --git a/doc/todo/bytes_in_privData__63__/comment_6_545e1c26a042b9f8347496a1bfb61548._comment b/doc/todo/bytes_in_privData__63__/comment_6_545e1c26a042b9f8347496a1bfb61548._comment
new file mode 100644
index 00000000..29b07e5c
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__/comment_6_545e1c26a042b9f8347496a1bfb61548._comment
@@ -0,0 +1,48 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2015-04-28T19:24:12Z"
+ content="""
+I've followed the same path in the wip-bytestring-privdata branch.
+
+It needs to round trip through String anyway to handle Read/Show
+serialization the same as before. I think this is doable without falling
+over on invalid encodings, but it's certianly ugly.
+
+And yeah, changing Line to ByteString and all the other follow-on changes
+just don't seem right. Everything that uses withPrivData would need to deal
+with it being a ByteString, and would need to worry about encoding problems
+when it needed to convert to a String, or Text, or whatever.
+
+So this feels like kicking the can down the road in the wrong direction...
+
+----
+
+Maybe it would be better to handle this by adding a type to wrap up an
+encoded ByteString in the PrivData. Could use base64 or something like
+that for the encoding. Then only consumers of these ByteStrings would be a
+little complicated by needing to unwrap it.
+
+Then it would be handly to give --set, --dump and --edit some
+special handling of fields encoded like that. They could operate on raw
+ByteStrings when handling such fields, and take care of the encoding
+details.
+
+Add a new constructor to PrivDataField for binary files:
+
+ | PrivBinaryFile FilePath
+
+And a function to get the encoder and decoder:
+
+ type Encoder = ByteString -> PrivData
+ type Decoder = PrivData -> ByteString
+
+ privDataEncoding :: PrivDataField -> Maybe (Encoder, Decoder)
+
+Then --set, --dump, and --edit could use that to encode and decode the
+data.
+
+And finally, a `withBinaryPrivData` that uses ByteString.
+
+(Maybe this could be made more type safe though..)
+"""]]
diff --git a/doc/todo/bytes_in_privData__63__/comment_7_d6c4c2645696eac448e906d812c2de62._comment b/doc/todo/bytes_in_privData__63__/comment_7_d6c4c2645696eac448e906d812c2de62._comment
new file mode 100644
index 00000000..07bc8145
--- /dev/null
+++ b/doc/todo/bytes_in_privData__63__/comment_7_d6c4c2645696eac448e906d812c2de62._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""mostly done"""
+ date="2015-09-15T00:26:10Z"
+ content="""
+A recent change converted PrivData to a newtype.
+There are no longer any things that directly use PrivData; all use
+should be via accessor functions like privDataLines and privDataVal.
+Which helps with this.
+
+So, I've instead implemented a `privDataByteString :: PrivData -> ByteString`,
+and I've adjusted the privdata serialization so it shouldn't crash
+on arbitrarily encoded data when eg, a binary file is fed into `propellor --set`.
+
+(Note that I was wrong earlier when I said it'd be safe to change the
+serialization to use ByteString; it must use String. While `"foo"`
+can be Read as a ByteString same as a string, `"foo\1000"`,
+when Read as a ByteString, truncates the big unicode character to
+a single byte. So, PrivData is still stored as Strings internally.)
+
+The final step would be to make `hasPrivContent` use `privDataByteString`
+instead of `privDataLines`. Which needs some more work to add Properties to
+ensure a file contains a ByteString. This should be pretty easy to do,
+but I lost steam..
+"""]]
diff --git a/doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn b/doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn
new file mode 100644
index 00000000..ff5d5434
--- /dev/null
+++ b/doc/todo/chroot_should_type_check_inner_and_outer_OS.mdwn
@@ -0,0 +1,9 @@
+Currently chroot properties containing any OS can be added to any host. Of
+course, some won't work. It would be nice to type check that the
+combination of inner and outer OS are compatable (ie, some linux on some
+linux).
+
+I have a partially done patch for that, but it failed at the last hurdle.
+See commit message 0b0ea182ab3301ade8b87b1be1cdecc3464cd1da
+
+[[!tag users/joey]]
diff --git a/doc/todo/commandline_to_setup_minimal_repo.mdwn b/doc/todo/commandline_to_setup_minimal_repo.mdwn
new file mode 100644
index 00000000..2b41d370
--- /dev/null
+++ b/doc/todo/commandline_to_setup_minimal_repo.mdwn
@@ -0,0 +1,7 @@
+Make propellor --init be a way to set up ~/.propellor. This would allow
+parameters, like --minimal to clone the minimal config repo instead of the
+full one, or --stack to set up ~/.propellor to use stack. --[[Joey]]
+
+> Or, it could be an interactive setup process. --[[Joey]]
+
+>> Made it interactive. [[done]] --[[Joey]]
diff --git a/doc/todo/concurrency.mdwn b/doc/todo/concurrency.mdwn
new file mode 100644
index 00000000..0d1dc847
--- /dev/null
+++ b/doc/todo/concurrency.mdwn
@@ -0,0 +1,114 @@
+Should be possible to add this, to construct a bunch of properties and
+run them in parallel:
+
+ concurrently :: IsProp p => (a -> p) -> [a] -> p
+
+Another version also nice to have:
+
+ race :: IsProp p => p -> p -> p
+
+Basic implementation should be pretty easy; propellor does not have a lot of
+mutable state to get in the way.
+
+The only hard part is, ensuring a property may cause arbitrary output,
+and it's not line-buffered necessarily, so there could be messy
+interleaving. I'm not sure how to deal with this, short of forking
+off a sub-process to ensure the property.
+
+----
+
+If forkProcess could be used, it could fork a subprocess that knows the
+action it's to perform, and jiggers stdio to feed through a pipe back to the
+parent.
+
+But, I have had bad luck in the past using forkProcess in haskell,
+in combination with the -threaded runtime.
+
+ forkProcess comes with a giant warning: since any other running threads
+ are not copied into the child process, it's easy to go wrong: e.g.
+ by accessing some shared resource that was held by another thread in
+ the parent.
+
+It may well be that since propellor has very
+little shared resources, and properties are run quite independently of
+one-another, a forkProcess to run a property might not be a problem.
+
+At least, until someone gets creative:
+
+ foo = property "foo" $ do
+ v <- liftIO newEmptyMVar
+ ensureProperty $
+ foo v `race` bar v -- FAIL
+
+We could detect if inside ensureProperty and refuse to do anything
+concurrent because the user might be up to such tricks.
+
+---
+
+Instead of forking, execing a new process would work. But, how to tell that
+sub-process which property it's supposed to ensure? There's no property
+serialization, and not even a Eq to use.
+
+Hmm, if it could come up with a stable, unique Id for each property, then
+the sub-process could be told the Id, and it'd then just look through its
+Host to find the property.
+
+This could be done by propellor's defaultMain, using Data.Unique (or a
+reimplementation that lets us get at the actual integer, rather than a hash
+of it). As long as it processes properties in a consistent order, that will
+generate the same Id for a property each time (until propellor is
+recompiled of course). The Id can be paired with the description of the
+property, to catch any version skew.
+
+But, this seems to not get all the way there. Having Id's for the top-level
+properties doesn't help in a situation like:
+
+ & propertyList "foo"
+ [ x `race` y
+ , a `race` b
+ ]
+
+x y a b are not top-level properties of a Host, so won't get unique Id's.
+Unless we can build up some tree of Id's that can be walked from the
+top-level down to the sub-properties, this won't work. Help?
+
+Also, what about mixing concurrency with ensureProperty?
+
+ foo = property "foo" $ do
+ liftIO defCon5
+ ensureProperty $
+ missleDefense `race` diplomacy
+ where
+ missleDefense = ...
+ diplomacy = ...
+
+Here there's no way for a propellor sub-process to know it needs to
+run part of foo to get to diplomacy. I think it would be ok to fall back to
+sequential mode in this case. So, the sub-process could signal with a
+special exit code that it couldn't find the requested Id, and then `race`
+can just wait for missleDefense to finish, and then run diplomacy.
+(Granted, this order may not be ideal in this specific case..)
+
+----
+
+Final option is to say, there are two sources of output when
+ensuring a property:
+
+* Propellor's own output, which is mostly gated through a few functions,
+ although of course the user can print anything they want too.
+* Output from running commands. Mostly done via cmdProperty, although
+ the user's also free to run commands in other ways.
+
+So, the Propellor monad could have a flag added to say that all output
+should be captured rather than output now, and just do that on a
+best-effort basis.
+
+Could even redirect stderr and stdout to a pipe, to capture any errant
+output. We'd not be able to tell which of the concurrent actions was
+responsible for such output, but it could be printed out, with appropriate
+warnings, at the end.
+
+[[!tag user/joey]]
+
+> [[done]]; use Propellor.Property.Concurrent to make properties run
+> concurrently. --[[Joey]]
diff --git a/doc/todo/concurrency/comment_1_0c428752e38798f0e8c8a72457c0a670._comment b/doc/todo/concurrency/comment_1_0c428752e38798f0e8c8a72457c0a670._comment
new file mode 100644
index 00000000..f5505140
--- /dev/null
+++ b/doc/todo/concurrency/comment_1_0c428752e38798f0e8c8a72457c0a670._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="cmt.miniBill@1ee673129c276f72c8d7c2974091af7618a22c2a"
+ nickname="cmt.miniBill"
+ subject="Output"
+ date="2016-02-01T23:09:49Z"
+ content="""
+Didn't you solve the output problem for git-annex?
+"""]]
diff --git a/doc/todo/concurrency/comment_2_d259eb0ff27327cc94542c9374d3da90._comment b/doc/todo/concurrency/comment_2_d259eb0ff27327cc94542c9374d3da90._comment
new file mode 100644
index 00000000..b2f2e192
--- /dev/null
+++ b/doc/todo/concurrency/comment_2_d259eb0ff27327cc94542c9374d3da90._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-02-02T16:04:31Z"
+ content="""
+Oh I forgot to close this. Propellor has had Propellor.Property.Concurrent
+for a while.
+"""]]
diff --git a/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn
new file mode 100644
index 00000000..d8493b27
--- /dev/null
+++ b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root.mdwn
@@ -0,0 +1,5 @@
+The recent dependency on concurrent-output adding implies downloading, compiling, and executing as root of many (MissingH, hslogger, process, unix-compat, network, directory, ansi-terminal, unix, ...) unstrusted sources. This seems like a huge security problem...
+
+Are these at least downloaded using https?
+
+> [[done]] --[[Joey]]
diff --git a/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment
new file mode 100644
index 00000000..39836219
--- /dev/null
+++ b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_1_683c5b754fd7922ff3193a2f8bc6fd2e._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-04-05T17:19:50Z"
+ content="""
+Yes, cabal is not secure from MITM.
+
+I've rethought adding that dependency so soon. I'll change back to bundling
+concurrent-output in 3.0.1.
+
+I can force ghc to build the concurrent-output
+module with -O2 as needed to get good memory use, and still let the rest of
+propellor build with -O0, which was the main motivation for unbundling it.
+"""]]
diff --git a/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_2_bd695a2e9ab90b355a71388dc6e7205d._comment b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_2_bd695a2e9ab90b355a71388dc6e7205d._comment
new file mode 100644
index 00000000..5c17f1bb
--- /dev/null
+++ b/doc/todo/concurrent-output_dependency_implies_compilation_of_a_lot_of_unstrusted_sources_as_root/comment_2_bd695a2e9ab90b355a71388dc6e7205d._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 2"
+ date="2016-04-05T18:41:31Z"
+ content="""
+great! thanks
+"""]]
diff --git a/doc/todo/depend_on_concurrent-output.mdwn b/doc/todo/depend_on_concurrent-output.mdwn
new file mode 100644
index 00000000..cf985166
--- /dev/null
+++ b/doc/todo/depend_on_concurrent-output.mdwn
@@ -0,0 +1,6 @@
+Currently a module from concurrent-output is inlined into propellor. This
+should be converted to a dependency.
+
+Waiting on concurrent-output reaching Debian stable.
+
+[[!tag user/joey]]
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn
new file mode 100644
index 00000000..55c3ef7e
--- /dev/null
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn
@@ -0,0 +1,15 @@
+Detecting and using `GHC_PACKAGE_PATH` would allow "stack exec" support. This way propellor would be able to be built with
+
+ stack build
+
+and run with
+
+ stack exec -- propellor ...
+
+see [[https://github.com/yesodweb/yesod/issues/1018]] and [[https://github.com/yesodweb/yesod/commit/a7cccf2a7c5df8b26da9ea4fdcb6bac5ab3a3b75]]
+
+> I don't think `stack exec propellor` makes sense to use.
+> Instead, `stack install propellor` and then put that in PATH.
+> I've now made `propellor --init` know when it was built using stack,
+> and it will set up propellor to continue to build itself using stack.
+> [[done]] --[[Joey]]
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_1_892385793c38976d0c446906dd004772._comment b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_1_892385793c38976d0c446906dd004772._comment
new file mode 100644
index 00000000..3154a895
--- /dev/null
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_1_892385793c38976d0c446906dd004772._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-06-29T20:25:10Z"
+ content="""
+I don't entirely understand this, though
+<https://github.com/haskell/cabal/pull/2270> seems to give some background.
+Patches welcome I suppose, although would't it be better to fix the tooling
+and not things like propellor that just use the tools?
+"""]]
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_2_c111d137cbaa72b4e6a4c7df3ce2063c._comment b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_2_c111d137cbaa72b4e6a4c7df3ce2063c._comment
new file mode 100644
index 00000000..21791330
--- /dev/null
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_2_c111d137cbaa72b4e6a4c7df3ce2063c._comment
@@ -0,0 +1,31 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 2"
+ date="2016-03-07T20:11:28Z"
+ content="""
+I got Propellor to work with stack by applying this patch (to disable the auto-building):
+
+```
+diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
+index 5dbc583..b83bb91 100644
+--- a/src/Propellor/CmdLine.hs
++++ b/src/Propellor/CmdLine.hs
+@@ -119,7 +119,7 @@ defaultMain hostlist = withConcurrentOutput $ do
+ fetchFirst (onlyprocess (update Nothing))
+ go _ (Update (Just h)) = update (Just h)
+ go _ Merge = mergeSpin
+- go cr cmdline@(Spin hs mrelay) = buildFirst cr cmdline $ do
++ go _ cmdline@(Spin hs mrelay) = buildFirst NoRebuild cmdline $ do
+ unless (isJust mrelay) commitSpin
+ forM_ hs $ \hn -> withhost hn $ spin mrelay hn
+ go cr (Run hn) = fetchFirst $
+```
+
+I then replaced the \"propellor\" binary/symlink with this little wrapper:
+
+```
+#!/bin/sh
+stack build && exec stack exec -- propellor-config \"$@\"
+```
+"""]]
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_3_40c1c09685acedb2f79726d6175544ab._comment b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_3_40c1c09685acedb2f79726d6175544ab._comment
new file mode 100644
index 00000000..b3af9c2c
--- /dev/null
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_3_40c1c09685acedb2f79726d6175544ab._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-03-08T05:42:59Z"
+ content="""
+Well, that's simple enough. Although there are a few other places that
+buildFirst and updateFirst are used, so the patch is not quite complete.
+
+I do want propellor to be able to be used with just cabal. For one thing,
+Debian stable doesn't even include stack yet! For another, all propellor's
+haskell dependencies are available in debian so it's overhead for stack to
+build them all.
+
+But, it'd be nice to support using stack too. If this were configurable
+in some way that propellor could see, then Propellor.Bootstrap.build
+could build with stack and update the symlink, and everything else would
+work as-is.
+
+So, what would be a good way to configure use of stack? It probably would
+make sense to have it be a property of the Host, which also allows the
+other bootstrap code to use stack to install dependencies.
+
+And then too, it could look at `GHC_PACKAGE_PATH`, so if your ~/.propellor
+is built using stack once, it will keep on building itself using stack.
+"""]]
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_4_1800ed279466eb210856e0bac8d46962._comment b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_4_1800ed279466eb210856e0bac8d46962._comment
new file mode 100644
index 00000000..29d0e330
--- /dev/null
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_4_1800ed279466eb210856e0bac8d46962._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-03-08T07:28:59Z"
+ content="""
+How about this simple approch: If stack.yaml exists, have propellor use
+stack for rebuilding itself.
+
+This assimes propellor doesn't ship a stack.yaml, which I think is ok.
+The user can `stack init` to create one.
+"""]]
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_6_36e0123127b60d1d9e9cf38783dc0c2c._comment b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_6_36e0123127b60d1d9e9cf38783dc0c2c._comment
new file mode 100644
index 00000000..28d39bc0
--- /dev/null
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_6_36e0123127b60d1d9e9cf38783dc0c2c._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2016-03-08T22:00:37Z"
+ content="""
+When stack.yaml exists, using --spin would need to get stack installed
+on the remote host, and use it to build propellor. Much as --spin currently
+gets cabal and ghc installed and uses them to build.
+"""]]
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_6_73842a5ea0d791cd05621778803e0b69._comment b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_6_73842a5ea0d791cd05621778803e0b69._comment
new file mode 100644
index 00000000..c56d2b7c
--- /dev/null
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_6_73842a5ea0d791cd05621778803e0b69._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 6"
+ date="2016-03-08T21:16:30Z"
+ content="""
+That sounds reasonable to me. One question, though; would this mean that if you commit stack.yaml to your repo (which I currently don't do), you have to have Propellor available on all the hosts you deploy to?
+"""]]
diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_7_dd93ac4f42dab131aa75fece53e51067._comment b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_7_dd93ac4f42dab131aa75fece53e51067._comment
new file mode 100644
index 00000000..5a488d25
--- /dev/null
+++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__/comment_7_dd93ac4f42dab131aa75fece53e51067._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2016-03-28T16:06:43Z"
+ content="""
+sm noticed that running the propellor wrapper after stack install propellor
+sets up ~/.propellor/ but fails to build in there, because it uses cabal.
+
+So, it appeared to him as if the propellor command didn't accept switches,
+since it never got to the point of running propellor-config. Which is
+pretty confusing behavior.
+
+To fully support stack, the wrapper or build process would need to notice
+that it was installed using stack, and build using stack. This conflicts
+somewhat with my idea about noticing if stack.yaml exists as the flag.
+"""]]
diff --git a/doc/todo/docker_todo_list.mdwn b/doc/todo/docker_todo_list.mdwn
index 72ded426..1321445d 100644
--- a/doc/todo/docker_todo_list.mdwn
+++ b/doc/todo/docker_todo_list.mdwn
@@ -1,5 +1,3 @@
* There is no way for a property of a docker container to require
some property be met outside the container. For example, some servers
need ntp installed for a good date source.
-* The SimpleSh was added before `docker exec` existed, and could probably
- be eliminated by using that.
diff --git a/doc/todo/dynamic_Info.mdwn b/doc/todo/dynamic_Info.mdwn
new file mode 100644
index 00000000..52ffdfe7
--- /dev/null
+++ b/doc/todo/dynamic_Info.mdwn
@@ -0,0 +1,4 @@
+nomeata suggested using Data.Dynamic for Info, so there doesn't need to be
+a big record centralizing all sorts of info. --[[Joey]]
+
+[[done]] --[[Joey]]
diff --git a/doc/todo/editor_for_privdata__63__.mdwn b/doc/todo/editor_for_privdata__63__.mdwn
new file mode 100644
index 00000000..8b91338c
--- /dev/null
+++ b/doc/todo/editor_for_privdata__63__.mdwn
@@ -0,0 +1,4 @@
+Would adding a way to call $EDITOR to edit privdata be possible?
+It would make sense for editing data like logcheck files.
+
+> [[done]]
diff --git a/doc/todo/editor_for_privdata__63__/comment_2_4fcbdf36f32ca7cf82593a8992167aff._comment b/doc/todo/editor_for_privdata__63__/comment_2_4fcbdf36f32ca7cf82593a8992167aff._comment
new file mode 100644
index 00000000..bbe93fe3
--- /dev/null
+++ b/doc/todo/editor_for_privdata__63__/comment_2_4fcbdf36f32ca7cf82593a8992167aff._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ subject="comment 2"
+ date="2014-11-11T21:16:09Z"
+ content="""
+Already exists in `propellor --edit`
+
+Documentation patches accepted! :)
+"""]]
diff --git a/doc/todo/fail_if_modification_not_commited_when_using_--spin.mdwn b/doc/todo/fail_if_modification_not_commited_when_using_--spin.mdwn
new file mode 100644
index 00000000..046f4a6f
--- /dev/null
+++ b/doc/todo/fail_if_modification_not_commited_when_using_--spin.mdwn
@@ -0,0 +1,3 @@
+Sometimes I forget to commit a modification, and running "propellor --spin" automatically commits this stuff. It would be better if "propellor --spin" failed (or, even better, warned the user) that there are uncommited changes, and "propellor --spin" would just always add an empty commit.
+
+> --merge added; [[done]] --[[Joey]]
diff --git a/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_1_7267d62ccc8db44bccb935836536e8a1._comment b/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_1_7267d62ccc8db44bccb935836536e8a1._comment
new file mode 100644
index 00000000..19b2fab6
--- /dev/null
+++ b/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_1_7267d62ccc8db44bccb935836536e8a1._comment
@@ -0,0 +1,30 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2014-11-23T18:41:40Z"
+ content="""
+Letting --spin commit is part of my workflow. It's great when you're just
+changing config.hs to quickly blast out the changes.
+
+Granted, it is not so nice when doing Property development, as changes get
+fragmented across the spins used to test them. I'd be happy to find some
+way to improve that. Perhaps a way could be found to get this structure of
+git commits:
+
+ manual commit------------------------->manual commit--merge
+ \--spin--spin--spin--spin--spin------------/
+
+Where the second manual commit has an identical tree committed as does the
+spin just underneath it, and so the following merge doesn't change any files,
+just grafts the two branches back together.
+
+I guess that could be handled by haing a checkpoint command, that squashes
+all the previous spins since the last checkpoint together into one commit,
+lets the user edit the commit message of that, and the juggles the branches
+into place and creates the merge commit -- which then becomes the new last
+checkpoint.
+
+I'll take patches for such a thing, or more simply a way to configure --spin's
+auto-committing behavior. However, I don't want to change the default
+behavior to not commit.
+"""]]
diff --git a/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_2_e4d170a14d689bef5d9174b251a4fe6f._comment b/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_2_e4d170a14d689bef5d9174b251a4fe6f._comment
new file mode 100644
index 00000000..3e8e5f62
--- /dev/null
+++ b/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_2_e4d170a14d689bef5d9174b251a4fe6f._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 2"
+ date="2014-11-23T20:23:24Z"
+ content="""
+Your solution seems a lot better :-).
+"""]]
diff --git a/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_3_c69eaa9c6ae5b07b5c2dd2591de965a3._comment b/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_3_c69eaa9c6ae5b07b5c2dd2591de965a3._comment
new file mode 100644
index 00000000..8ad6ab49
--- /dev/null
+++ b/doc/todo/fail_if_modification_not_commited_when_using_--spin/comment_3_c69eaa9c6ae5b07b5c2dd2591de965a3._comment
@@ -0,0 +1,19 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2014-11-23T21:12:19Z"
+ content="""
+Here's a almost-script to do it, which worked when it did it by hand:
+
+<pre>
+get old-head (git show-ref HEAD -s)
+get curr-branch (refs/heads/master eg)
+find old-commit (look back through git log for the first commit that was not "propellor spin")
+git reset old-commit
+git commit -a # user gets to edit commit message for all the spins and any staged changes here
+git merge -S -s ours old-head
+get current-commit (result of merge)
+git update-ref curr-branch current-commit
+git checkout curr-branch
+</pre>
+"""]]
diff --git a/doc/todo/git_push_over_propellor_ssh_channel.mdwn b/doc/todo/git_push_over_propellor_ssh_channel.mdwn
index cac0bfea..c6d42fcf 100644
--- a/doc/todo/git_push_over_propellor_ssh_channel.mdwn
+++ b/doc/todo/git_push_over_propellor_ssh_channel.mdwn
@@ -9,3 +9,5 @@ the local one runs `git send-pack`.
Then there would be no need for a central git repo. Although still very
useful if you have multiple propellor driven hosts and you want to just git
commit and let cron sort them out.
+
+> [[done]]! --[[Joey]]
diff --git a/doc/todo/hooks.mdwn b/doc/todo/hooks.mdwn
index a62aa5e7..4617c2b9 100644
--- a/doc/todo/hooks.mdwn
+++ b/doc/todo/hooks.mdwn
@@ -1,7 +1,4 @@
* Need a way to run an action when a property changes, but only
run it once for the whole. For example, may want to restart apache,
but only once despite many config changes being made to satisfy
- properties. onChange is a poor substitute.a
-* Relatedly, a property that say, installs systemd needs to have a way
- to reboot the system when a change is made. But this should only
- happen at the very end, after everything else.
+ properties. onChange is a poor substitute.
diff --git a/doc/todo/hooks/comment_1_4ca9e46f36d0fae334d9c2f2c211d0e3._comment b/doc/todo/hooks/comment_1_4ca9e46f36d0fae334d9c2f2c211d0e3._comment
new file mode 100644
index 00000000..a2a2416d
--- /dev/null
+++ b/doc/todo/hooks/comment_1_4ca9e46f36d0fae334d9c2f2c211d0e3._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-20T16:40:43Z"
+ content="""
+There's `endAction` which can be used to register an action to run after
+all properties have run. This could pretty easily be extended to take
+a MVar associated with the action and use it to only run the action once.
+
+However, running actions at the end of the propellor run doesn't let other
+properties depend on the results of those actions. If an property
+configures apache, and another property somehow depends on apache being
+configured, deferring the apache restart to an endAction wouldn't work.
+"""]]
diff --git a/doc/todo/info_propigation_out_of_nested_properties.mdwn b/doc/todo/info_propigation_out_of_nested_properties.mdwn
index 9e69b0b4..4176213a 100644
--- a/doc/todo/info_propigation_out_of_nested_properties.mdwn
+++ b/doc/todo/info_propigation_out_of_nested_properties.mdwn
@@ -1,28 +1,97 @@
-Currently, Info about a Host's Properties is manually gathered and
-propigated. propertyList combines the Info of the Properties in the list.
-Docker.docked extracts relevant Info from the Properties of the container
-(but not al of it, intentionally!).
+> Now [[fixed|done]]!! --[[Joey]]
-This works, but it's error-prone. Consider this example:
+Currently, Info about a Host's Properties is propagated to the host by
+examining the tree of Properties.
+
+This works, but there's one problem. Consider this example:
withOS desc $ \o -> case o of
(Just (System (Debian Unstable) _)) -> ensureProperty foo
_ -> ensureProperty bar
-Here, the Info of `foo` is not propigated out. Nor is `bar`'s Info.
-Of course, only one of them will be run, and only its info should be propigated
-out..
+Here, the Info of `foo` is not propagated out. Nor is `bar`'s Info.
+It's not really clear if just one Info, or both should be propagated out.
+
+----
One approach might be to make the Propellor monad be able to be run in two
-modes. In one mode, it actually perform IO, etc. In the other mode, all
-liftIO is a no-op, but all Info encountered is accumulated using a Reader
-monad. This might need two separate monad definitions.
-
-That is surely doable, but the withOS example above shows a problem with it --
-the OS is itself part of a Host's info, so won't be known until all its
-properties have been examined for info!
-
-Perhaps that can be finessed. We don't really need to propigate out OS info.
-Just DNS and PrivDataField Info. So info could be collected in 2 passes,
-first as it's done now by static propertyInfo values. Then by running
-the Properties in the Reader monad.
+modes. In run mode, it actually performs IO, etc. In introspection mode, all
+liftIO is a no-op, but all Info encountered is accumulated using a Reader.
+This might need two separate monad definitions.
+
+That is surely doable, but consider this example:
+
+ property "demo" = do
+ needfoo <- liftIO checkFoo
+ if needfoo
+ then ensureProperty foo
+ else ensureProperty . bar =<< liftIO (getBarParam)
+
+In introspection mode, the liftIO is a no-op, but needs to return a Bool.
+That seems unlikely (how to pick which?), but even if some defaulting is
+used, only one of foo or bar's info will be seen.
+
+Worse, the bar property is not fully known until IO can be performed to get
+its parameter.
+
+----
+
+Another approach could be something like this:
+
+ withInfoFrom foo $ \callfoo ->
+ withInfoFrom bar $ \callbar ->
+ property "demo" = do
+ needfoo <- liftIO checkFoo
+ if needfoo
+ then callfoo
+ else callbar
+
+Here withInfoFrom adds foo and bar as child properties of the demo property
+that (may) call them.
+
+This approach is not fully type safe; it would be possible to call
+withInfoFrom in a way that didn't let it propagate the info.
+
+And again this doesn't solve the problem that IO can be needed to get
+a parameter of a child property.
+
+----
+
+Another approach would be to add a new SimpleProperty, which is a property
+that has no Info. Only allow calling ensureProperty on this new type.
+
+(Or, remove propertyInfo from Property, and add a new InfoProperty that
+has the info.)
+
+But, propertyList can only contain one type at a time,
+not a mixed list of Property and SimpleProperty.
+
+Could a GADT be used instead?
+
+ {-# LANGUAGE GADTs #-}
+ {-# LANGUAGE EmptyDataDecls #-}
+
+ data HasInfo
+ data NoInfo
+
+ data Property = IProperty (GProperty HasInfo) | SProperty (GProperty NoInfo)
+
+ data GProperty i where
+ GIProperty :: Desc -> Propellor Result -> Info -> GProperty HasInfo
+ GSProperty :: Desc -> Propellor Result -> GProperty NoInfo
+
+ ensureProperty :: GProperty NoInfo -> Propellor Result
+ ensureProperty (GSProperty d r) = r
+
+That works. I made a `gadtwip` git branch that elaborated on that,
+to the point that Property.File compiles, but is otherwise
+unfinished. Most definitions of `Property` need to be changed to
+`GProperty NoInfo`, so that ensureProperty can call them. It's a big,
+intrusive change, and it may complicate propellor too much.
+
+I've tried to make this change a couple times now, and not been completely
+successful so far.
+
+(I may need to make instances of Prop for `GProperty NoInfo` and `GProperty
+HasInfo`, if that's possible, and make more Property combinators work on
+Prop.)
diff --git a/doc/todo/integrate_shell-monad.mdwn b/doc/todo/integrate_shell-monad.mdwn
new file mode 100644
index 00000000..0b2ea4fc
--- /dev/null
+++ b/doc/todo/integrate_shell-monad.mdwn
@@ -0,0 +1,11 @@
+Propellor often generates some shell code to run.
+Examples include Propellor.Bootstrap, but also things like
+userScriptProperty where a shell command has to be built that can be fed
+into sudo.
+
+The current code for this is just all strings and easy to make mistakes in.
+It would be good to integrate <http://hackage.haskell.org/package/shell-monad>
+(or a similar library) as a way to generate shell code. --[[Joey]]
+
+<http://hackage.haskell.org/package/turtle> might be another good option
+--[[Joey]]
diff --git a/doc/todo/issue_after_upgrading_shared_library.mdwn b/doc/todo/issue_after_upgrading_shared_library.mdwn
new file mode 100644
index 00000000..52e72d4a
--- /dev/null
+++ b/doc/todo/issue_after_upgrading_shared_library.mdwn
@@ -0,0 +1,25 @@
+After upgrading my server to jessie, I noticed that propellor does not work anymore. The issue seems to be that, libffi was upgraded from libffi5:amd64 to libffi6:amd64
+
+ $ ./propellor --spin myserver
+ Building propellor-2.2.1...
+ Preprocessing library propellor-2.2.1...
+ In-place registering propellor-2.2.1...
+ Preprocessing executable 'propellor' for propellor-2.2.1...
+ Preprocessing executable 'propellor-config' for propellor-2.2.1...
+ Propellor build ... done
+
+ You need a passphrase to unlock the secret key for
+ user: bla
+
+ [master 2aabb40] propellor spin
+ Git commit ... done
+ Counting objects: 1, done.
+ Writing objects: 100% (1/1), 852 bytes | 0 bytes/s, done.
+ Total 1 (delta 0), reused 0 (delta 0)
+ To root@myserver:/var/lib/git/private/propellor.git
+ b16f1a6..2aabb40 master -> master
+ Push to central git repository ... done
+ ./propellor: error while loading shared libraries: libffi.so.5: cannot open shared object file: No such file or directory
+ propellor: user error (ssh ["-o","ControlPath=/home/myuser/.ssh/propellor/myserver.sock","-o","ControlMaster=auto","-o","ControlPersist=yes","root@myserver","sh -c 'if [ ! -d /usr/local/propellor/.git ] ; then (if ! git --version >/dev/null; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git; fi && echo STATUSNeedGitClone) || echo STATUSNeedPrecompiled ; else cd /usr/local/propellor && if ! test -x ./propellor; then ( apt-get update ; apt-get --no-upgrade --no-install-recommends -y install gnupg ; apt-get --no-upgrade --no-install-recommends -y install ghc ; apt-get --no-upgrade --no-install-recommends -y install cabal-install ; apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-missingh-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-hslogger-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-unix-compat-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-ansi-terminal-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-ifelse-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-network-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-quickcheck2-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-mtl-dev ; apt-get --no-upgrade --no-install-recommends -y install libghc-monadcatchio-transformers-dev ; cabal update ; cabal install --only-dependencies ) || true && cabal configure && cabal build && ln -sf dist/build/propellor-config/propellor-config propellor; fi && ./propellor --boot myserver ; fi'"] exited 127)
+
+> [[fixed|done]] --[[Joey]]
diff --git a/doc/todo/issue_after_upgrading_shared_library/comment_1_8d9144d57871cb5d234710d1ab1b7183._comment b/doc/todo/issue_after_upgrading_shared_library/comment_1_8d9144d57871cb5d234710d1ab1b7183._comment
new file mode 100644
index 00000000..77c7df83
--- /dev/null
+++ b/doc/todo/issue_after_upgrading_shared_library/comment_1_8d9144d57871cb5d234710d1ab1b7183._comment
@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-04-02T01:14:06Z"
+ content="""
+I think I saw this once myself (have no servers older than jessie left
+now).
+
+I believe the problem can be worked around by running make clean
+in /usr/local/propellor on the server.
+
+I'm not clear yet on a good way for --spin to detect that propellor
+has failed due to this, rather than some other problem, and try
+a clean and rebuild.
+
+Hmm, xmonad should have a similar problem, since it builds a haskell
+program locally. I wonder how the debian package deals with it there.
+
+Note there's a libffi6, so this will presumably happen again..
+"""]]
diff --git a/doc/todo/issue_after_upgrading_shared_library/comment_2_01a3d5e006158302e12862cacee3327e._comment b/doc/todo/issue_after_upgrading_shared_library/comment_2_01a3d5e006158302e12862cacee3327e._comment
new file mode 100644
index 00000000..3f7a7bbc
--- /dev/null
+++ b/doc/todo/issue_after_upgrading_shared_library/comment_2_01a3d5e006158302e12862cacee3327e._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 2"
+ date="2015-04-02T09:24:07Z"
+ content="""
+Indeed, \"make clean\" on the server worked. I don't know it could be made more robust to this kind of upgrade...
+"""]]
diff --git a/doc/todo/issue_after_upgrading_shared_library/comment_2_6025ec35330fbac220f2888e60be1e78._comment b/doc/todo/issue_after_upgrading_shared_library/comment_2_6025ec35330fbac220f2888e60be1e78._comment
new file mode 100644
index 00000000..bc89ad7f
--- /dev/null
+++ b/doc/todo/issue_after_upgrading_shared_library/comment_2_6025ec35330fbac220f2888e60be1e78._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-04-02T14:27:26Z"
+ content="""
+So I thought of two approaches.
+
+1. Propellor could copy in all the shared libraries. It already contains
+ code to do this. But, this would add overhead to every build. And it
+ might not guard against all snafus.
+
+2. Make propellor --check that should exit 0. Make --spin check that
+ propellor works and rebuild if not. Also make the runPropellor cron job
+ do that.
+
+I've gone with option #2.
+"""]]
diff --git a/doc/todo/lxc_containers_support.mdwn b/doc/todo/lxc_containers_support.mdwn
new file mode 100644
index 00000000..5e9da306
--- /dev/null
+++ b/doc/todo/lxc_containers_support.mdwn
@@ -0,0 +1 @@
+Adding lxc containers support would be great, as an alternative to docker, chroot, or systemd containers.
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn b/doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn
new file mode 100644
index 00000000..96c08d53
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn
@@ -0,0 +1,20 @@
+Please consider merging branch `sbuild` of repository `https://git.spwhitton.name/propellor`.
+
+This branch adds the following features:
+
+- A new module `Propellor.Property.Sbuild` with properties for configuring sbuild schroots
+- A new module `Propellor.Property.Schroot` with a property supporting those in `Propellor.Property.Sbuild`
+- A new module `Propellor.Property.Ccache` with a property supporting those in `Propellor.Property.Sbuild`
+- An export of `extractSuite` from `Propellor.Property.Debootstrap`, used in `Propellor.Property.Sbuild`
+- Two new types of iptables matching rules in `Propellor.Property.Firewall`.
+
+The additions to `Propellor.Property.Firewall` were made to support `Sbuild.blockNetwork`, which is a hack from the Debian Wiki which doesn't seem to work with the latest version of sbuild. I left the additions to `Propellor.Property.Firewall` in my branch since they are probably independently useful. I left the `blockNetwork` property commented-out in `Sbuild.hs` in case I or someone else can make it work at a later date.
+
+I get the following strange warning from GHC thanks to my new export from `Propellor.Property.Debootstrap`. I can't figure out the problem and would be grateful for help.
+
+ src/Propellor/Property/Debootstrap.hs:8:9: Warning:
+ `extractSuite' is exported by `extractSuite' and `extractSuite'
+
+--spwhitton
+
+> [[merged|done]]; thank you! --[[Joey]]
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_1_b3343283b2d7d49ab70a95d762d0e081._comment b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_1_b3343283b2d7d49ab70a95d762d0e081._comment
new file mode 100644
index 00000000..89583ffc
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_1_b3343283b2d7d49ab70a95d762d0e081._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-21T17:41:11Z"
+ content="""
+Re not running propellor in the sbuild chroot, I have in the past used
+schroot for things where it would have made sense to run propellor
+in the chroot. OTOH, systemd-container is a better fit for such uses cases
+now, probably.
+
+Is the ~/.sbuildrc necessary to use the sbuild properties? If so,
+would it make sense to have a property that configures it?
+
+You could use Utility.DataUnits for Ccache's MaxSize. This would be
+more flexible and consistent with other things in propellor.
+
+Limit could be a monoid. This would perhaps simplify hasGroupCache
+as it could only be used once to set multiple limits.
+
+Maybe instead of Ccache.hasGroupCache, call it Ccache.hasCache?
+
+That is a weird build warning! But, I don't see it with ghc 7.10.3.
+Normally you'd see that warning when the module's export list exported the same
+symbol twice.
+"""]]
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_2_d8afe7b1fd49df5794c9abf2be732f8b._comment b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_2_d8afe7b1fd49df5794c9abf2be732f8b._comment
new file mode 100644
index 00000000..44a2a542
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_2_d8afe7b1fd49df5794c9abf2be732f8b._comment
@@ -0,0 +1,58 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 2"
+ date="2016-05-22T01:48:27Z"
+ content="""
+Thanks for your feedback.
+
+> Re not running propellor in the sbuild chroot, I have in the past used
+> schroot for things where it would have made sense to run propellor in
+> the chroot. OTOH, systemd-container is a better fit for such uses
+> cases now, probably.
+
+I was thinking that if someone wanted to use a schroot and run
+propellor in it, useful properties could be appended to
+`Propellor.Property.Schroot`. As far as types go, I think that the
+types in `Propellor.Property.Chroot` would be sufficient.
+
+> Is the ~/.sbuildrc necessary to use the sbuild properties? If so,
+> would it make sense to have a property that configures it?
+
+The only probably which *needs* the suggested ~/.sbuildrc is
+`Sbuild.piupartsConfFor`. With the other properties and no
+~/.sbuildrc, you should be able to go ahead and use sbuild(1) to
+perform a clean build.
+
+I don't think there is a way to write a non-intrusive property to add
+anything to a user's ~/.sbuildrc. That's because they will probably
+have different preferences for the options to pass to piuparts than I
+give in the example, and we would have to merge the adt-run code with
+any existing post-build-commands. I'm not sure propellor should have
+a perl config file parser.
+
+> You could use Utility.DataUnits for Ccache's MaxSize. This would be
+> more flexible and consistent with other things in propellor.
+
+Done.
+
+> Limit could be a monoid. This would perhaps simplify hasGroupCache as
+> it could only be used once to set multiple limits.
+
+Done.
+
+> Maybe instead of Ccache.hasGroupCache, call it Ccache.hasCache?
+
+Done, I think that's better. I was originally thinking that the name
+`Ccache.hasCache` might be for a property `User -> Property
+DebianLike`. However, if someone wanted to write a property configuring
+a user cache, it would probably have the standard location
+`~/.ccache`. This cache would be implicitly created when required, so
+the name `Ccache.hasCache` would be needed.
+
+> That is a weird build warning! But, I don't see it with ghc
+> 7.10.3. Normally you'd see that warning when the module's export list
+> exported the same symbol twice.
+
+I'm on GHC 7.10.3, too...
+
+"""]]
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_3_679468488a88f0a3f28ea0be548691a0._comment b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_3_679468488a88f0a3f28ea0be548691a0._comment
new file mode 100644
index 00000000..7d5da612
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_3_679468488a88f0a3f28ea0be548691a0._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-22T17:53:42Z"
+ content="""
+Would it make sense to move the ~/.sbuildrc example into the documentation
+for the property that uses it?
+"""]]
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_4_bae208f52cb01eeb6d95a06dd4d5466a._comment b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_4_bae208f52cb01eeb6d95a06dd4d5466a._comment
new file mode 100644
index 00000000..fc7a8005
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_4_bae208f52cb01eeb6d95a06dd4d5466a._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 4"
+ date="2016-05-22T22:39:24Z"
+ content="""
+I've copied the relevant part to the documentation for that property.
+
+I'd like to retain the whole suggested ~/.sbuildrc content at the top of the haddock. The purpose of the suggested config.hs lines is to set up everything you need to be able to run sbuild with both piuparts and adt-run -- the \"complete setup\". You don't get all of that by just running `sbuild-createchroot` from a command line. So having both the config.hs lines and the ~/.sbuildrc lines at the top of the haddock makes it clear what the module can do for the user.
+"""]]
diff --git a/doc/todo/merge_request:___96__propellor_--init__96___should_sometimes_run___96__cabal_sandbox_init__96__.mdwn b/doc/todo/merge_request:___96__propellor_--init__96___should_sometimes_run___96__cabal_sandbox_init__96__.mdwn
new file mode 100644
index 00000000..eb7f561b
--- /dev/null
+++ b/doc/todo/merge_request:___96__propellor_--init__96___should_sometimes_run___96__cabal_sandbox_init__96__.mdwn
@@ -0,0 +1,5 @@
+Please consider merging branch `fix-init-build` of repository `https://git.spwhitton.name/propellor`.
+
+`propellor --init` can fail if the build system is cabal and the user has `require-sandbox: True` in `~/.cabal/config`. This patch fixes that.
+
+> [[merged|done]] --[[Joey]]
diff --git a/doc/todo/missing_dependencies.mdwn b/doc/todo/missing_dependencies.mdwn
new file mode 100644
index 00000000..2b2ac0f4
--- /dev/null
+++ b/doc/todo/missing_dependencies.mdwn
@@ -0,0 +1,41 @@
+After upgrading to 2.4.0, I get this error:
+
+ ./propellor --spin myserver
+ Building propellor-2.4.0...
+ Preprocessing library propellor-2.4.0...
+ In-place registering propellor-2.4.0...
+ Preprocessing executable 'propellor' for propellor-2.4.0...
+ Preprocessing executable 'propellor-config' for propellor-2.4.0...
+ Propellor build ... done
+ Git commit ... done
+ Enter passphrase for /home/user/.ssh/id_rsa:
+ Identity added: /home/user/.ssh/id_rsa (/home/user/.ssh/id_rsa)
+ Counting objects: 253, done.
+ Delta compression using up to 4 threads.
+ Compressing objects: 100% (253/253), done.
+ Writing objects: 100% (253/253), 173.59 KiB | 0 bytes/s, done.
+ Total 253 (delta 172), reused 0 (delta 0)
+ To root@myserver:/var/lib/git/private/propellor.git
+ d81fb7d..6f7f041 master -> master
+ Push to central git repository ... done
+ From myserver:/var/lib/git/private/propellor
+ d81fb7d..6f7f041 master -> origin/master
+ Pull from central git repository ... done
+ ** warning: git branch origin/master is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)
+ Sending privdata (87652 bytes) to myserver ... done
+ From .
+ * branch HEAD -> FETCH_HEAD
+ Sending git update to myserver ... done
+ Warning: The package list for 'hackage.haskell.org' is 47 days old.
+ Run 'cabal update' to get the latest list of available packages.
+ Resolving dependencies...
+ Configuring propellor-2.4.0...
+ cabal: At least the following dependencies are missing:
+ exceptions -any
+ propellor: failed to make dist/setup-config
+ Shared connection to myserver closed.
+ propellor: remote propellor failed
+
+As in https://propellor.branchable.com/todo/issue_after_upgrading_shared_library/, manually running "make clean" on the server fixed the issue
+
+> Ok, this is the same as [[problem_with_spin_after_new_dependencies_added]]. Closing this issue as I'm dealing with it in the other one. [[done]] --[[Joey]]
diff --git a/doc/todo/missing_dependencies/comment_1_826a75052e87c04489aa07c3d322a54f._comment b/doc/todo/missing_dependencies/comment_1_826a75052e87c04489aa07c3d322a54f._comment
new file mode 100644
index 00000000..2ccb179d
--- /dev/null
+++ b/doc/todo/missing_dependencies/comment_1_826a75052e87c04489aa07c3d322a54f._comment
@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-05-22T18:13:15Z"
+ content="""
+`exceptions` is indeed a new dependency.
+
+This is supposed to be handled by Propellor.Bootstrap.checkDepsCommand
+which is run by --spin.
+
+Maybe check if your propellor.cabal includes the `exceptions` dependency,
+and check if `cabal configure` fails. If it does, it seems like that code
+would fire, and should install the missing dependency. It worked when I
+upgraded my systems with it, is all I know.
+"""]]
diff --git a/doc/todo/multi_gpg_key_privdata.mdwn b/doc/todo/multi_gpg_key_privdata.mdwn
new file mode 100644
index 00000000..3ee6b3b8
--- /dev/null
+++ b/doc/todo/multi_gpg_key_privdata.mdwn
@@ -0,0 +1,14 @@
+To support multiple gpg keys added with --add-key, propellor should
+
+* When it encrypts the privdata after a change, encrypt it to all keys
+ listed in `privdata/keyring.gpg`. See [this
+ post](http://laurent.bachelier.name/2013/03/gpg-encryption-to-multiple-recipients/)
+ explaining why and how encryption with multiple recipients work.
+* When --add-key adds a new key, it should re-encrypt the privdata,
+ so that this new key can access it.
+* When --add-key on behalf of another user, do not modify the signing key for
+ local git. This entails either splitting this command in two, `--add-key` and
+ `--set-signing-key`, or adding another command `--add-foreign-key`,
+ or perhaps determining if the key being added has a known secret key.
+
+[[done]]
diff --git a/doc/todo/onChange_failure_handling.mdwn b/doc/todo/onChange_failure_handling.mdwn
new file mode 100644
index 00000000..46a81caf
--- /dev/null
+++ b/doc/todo/onChange_failure_handling.mdwn
@@ -0,0 +1,41 @@
+> Please consider the following three properties
+> - p1,
+> - p2 and
+> - p3 = onChange p1 p2.
+>
+> If p1 returns MadeChange and p2 FailedChange, then p3 is FailedChange.
+> If we apply this property again without any changes, then p3 is
+> NoChange.
+>
+> This behavior could create problematic situations since p3 can be
+> required by another property which thinks that p3 has been applied
+> whereas it's not the case...
+>
+> -- Antoine
+
+Very well stated.
+
+I looked over existing uses of onChange in propellor, and many of them
+seem safe.
+
+The safe ones are where there's eg, a daemon, with a Property that it's
+running, and another Property that configures it in some way with
+onChange restart. If the restart fails, then the daemon is presumably
+left not running (unless it failed to stop the daemon somehow); a state
+that the former Property will attempt to take care of (or at least
+continue to indicate failure on) the next time propellor runs.
+
+Hmm, there are also lots of uses of onChange reloaded. If the new
+configuration of a daemon is broken, this can fail to reload it, and
+leave the daemon running with the old configuration. So that's more
+problimatic, and then there are some more problimatic yet uses of
+onChange, like the one that runs apt-get update after a change to
+sources.list.
+
+--[[Joey]]
+
+----
+
+The `onChangeFlagOnFail` combinator is a safer alternative to `onChange`
+that avoids this problem. But, it can be difficult to come up with unique
+names for the flag files it uses.
diff --git a/doc/todo/privdata_file_split.mdwn b/doc/todo/privdata_file_split.mdwn
new file mode 100644
index 00000000..655067c9
--- /dev/null
+++ b/doc/todo/privdata_file_split.mdwn
@@ -0,0 +1,27 @@
+Currently all the privdata is written into a single encrypted file.
+
+This makes it more likely that, if multiple people are co-administering
+with propellor, they will make conflicting changes to the privdata.
+And resulving such a conflict would be pretty tricky.
+
+This could be improved by splitting up the privdata file, so there's one
+encrypted file per item. Conflicting commits would then be less likely,
+and even if they happened, it would only be one item in conflict, so
+should be eaiser to resolve it.
+
+Are there privacy concerns with splitting privdata? It would let anyone who
+can access the repository but not decrypt it guess more about its
+properties.
+
+They could look at the size of an item and make guesses about eg, the
+length of a password. This could be blocked by padding the privdata, but it
+would need to be padded before encryption with binary garbage.
+
+They could also enumerate the various privdata fields. However, this can already
+be done by looking at the propellor configuration, so I don't think it's a
+problem.
+
+Finally, an attacker could look at the history of what privdata changed
+when. Currently, all an attacker can see is that some change was made to
+the privdata file; splitting it up would let them see which fields were
+changed when.
diff --git a/doc/todo/problem_with_spin_after_new_dependencies_added.mdwn b/doc/todo/problem_with_spin_after_new_dependencies_added.mdwn
new file mode 100644
index 00000000..a7b94472
--- /dev/null
+++ b/doc/todo/problem_with_spin_after_new_dependencies_added.mdwn
@@ -0,0 +1,48 @@
+Using --spin against a remote host after new cabal deps are added fails.
+
+<pre>
+Sending git update to clam.kitenet.net ... done
+Pull from central git repository ... done
+git branch origin/joeyconfig gpg signature verified; merging
+Already up-to-date.
+Warning: The package list for 'hackage.haskell.org' is 77.9 days old.
+Run 'cabal update' to get the latest list of available packages.
+Resolving dependencies...
+Configuring propellor-3.0.0...
+cabal: At least the following dependencies are missing:
+concurrent-output -any
+propellor: failed to make dist/setup-config
+Shared connection to clam.kitenet.net closed.
+propellor: remote propellor failed
+- exit 1
+</pre>
+
+This is a blocker for merging the typed-os-requirements branch.
+
+Problem is, the remote propellor runs Propellor.Bootstrap.build to build
+itself after updating the git tree. But that does not install any missing
+cabal deps.
+
+It can be made to, but there are three problems:
+
+1. For it to use depsCommand to install missing deps, it needs to know
+ the target OS of the host it's running on. That would need to be
+ extracted from other info.
+2. Propellor.Bootstrap.build is also run when local propellor builds
+ itself, and if cabal failed there, it's not running as root and so can't
+ install deps. And probably shouldn't try to anyhow.
+3. Even if Propellor.Bootstrap.build is fixed to install deps,
+ this would still require an upgrade to get that fix before new deps can
+ be added. This presents difficulties in merging the
+ typed-os-requirements branch.
+
+Instead of fixing this in Propellor.Bootstrap.build, could it be fixed
+in the --spin code? That could run the depsCommand, but that's too
+expensive to do every time. Only need to do it if the remote
+propellor's build of itself fails. How to tell when that happened,
+vs when propellor built ok, ran, and exited nonzero due to a failing property?
+
+(Note that the cron job runs the depsCommand if cabal configure fails,
+so deps do get installed that way, only --spin is a problem.)
+
+> [[done]] --[[Joey]]
diff --git a/doc/todo/problem_with_spin_after_new_dependencies_added/comment_1_3adbcc7db82f14d10c7efaba889ab009._comment b/doc/todo/problem_with_spin_after_new_dependencies_added/comment_1_3adbcc7db82f14d10c7efaba889ab009._comment
new file mode 100644
index 00000000..9020078c
--- /dev/null
+++ b/doc/todo/problem_with_spin_after_new_dependencies_added/comment_1_3adbcc7db82f14d10c7efaba889ab009._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ subject="comment 1"
+ date="2016-03-30T19:30:50Z"
+ content="""
+Well, I don't see a way around needing to release a version of propellor that fixes this bug before I can release a version of propellor that depends on the fix (by adding a new dependency on concurrent-output).
+
+So, I'll go that route. Users will need to upgrade all deployed hosts to propellor 2.17.2 first, before 3.0.0. If a user neglects to do so, and tries to update a host using propellor --spin, it will fail. The user can then either
+
+1. Wait for the cron job to run, if they set it up, which will install the deps.
+2. Manually log into the host and fix the deps by eg, cabal install concurrent-output as root.
+"""]]
diff --git a/doc/todo/propellor_--init_option_B_failure.mdwn b/doc/todo/propellor_--init_option_B_failure.mdwn
new file mode 100644
index 00000000..f706cba6
--- /dev/null
+++ b/doc/todo/propellor_--init_option_B_failure.mdwn
@@ -0,0 +1,41 @@
+[[!tag user/spwhitton]]
+
+With 3.0.1, 3.0.2 or 3.0.3:
+
+ artemis ~ % propellor --init
+
+
+ _ ______`| ,-.__
+ .--------------------------- / \___-=O`/|O`/__| (____.'
+ - Welcome to -- \ / | / ) _.-'-._
+ - Propellor! -- `/-==__ _/__|/__=-| ( \_
+ `--------------------------- * \ | | '--------'
+ (o) `
+
+
+ Propellor's configuration file is ~/.propellor/config.hs
+
+ Let's get you started with a simple config that you can adapt
+ to your needs. You can start with:
+ A: A clone of propellor's git repository (most flexible)
+ B: The bare minimum files to use propellor (most simple)
+ Which would you prefer? [A|B] B
+ Initialized empty Git repository in /home/swhitton/.propellor/.git/
+ Creating minimal config ... done
+
+ ------------------------------------------------------------------------------
+
+ Let's try building the propellor configuration, to make sure it will work...
+
+ Writing a default package environment file to
+ /home/swhitton/.propellor/cabal.sandbox.config
+ Creating a new sandbox at /home/swhitton/.propellor/.cabal-sandbox
+ Resolving dependencies...
+ Configuring config-0...
+ cabal: At least the following dependencies are missing:
+ propellor >=3.0
+ propellor: failed to make dist/setup-config
+
+(propellor installed from Debian)
+
+: This is in the NEW queue. [[done]] --spwhitton
diff --git a/doc/todo/propellor_--init_option_B_failure/comment_1_f2229a499f4be0e64d030e2ecc0927f6._comment b/doc/todo/propellor_--init_option_B_failure/comment_1_f2229a499f4be0e64d030e2ecc0927f6._comment
new file mode 100644
index 00000000..e9edb435
--- /dev/null
+++ b/doc/todo/propellor_--init_option_B_failure/comment_1_f2229a499f4be0e64d030e2ecc0927f6._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-02T12:03:24Z"
+ content="""
+You need to update the Debian package to include the propellor
+haskell library in binary form. I had not included the haskell library in
+the package before in binary form, because I was targeting only option A,
+where it's cloned from the git archive in the package.
+
+Any other installation method than the debian package that I know of
+installs both the propellor command and the propellor haskell library.
+
+(Note that propellor 3.0.1^W3.0.3 fixes an unrelated bug that prevented option B
+from working.)
+"""]]
diff --git a/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN.mdwn b/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN.mdwn
new file mode 100644
index 00000000..fad2a1e0
--- /dev/null
+++ b/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN.mdwn
@@ -0,0 +1,17 @@
+I'd like to patch the `/usr/bin/propellor` wrapper to check for two environment variables. I'm posting my proposal here to see whether Joey would be willing to merge such a patch before starting to write it.
+
+# Proposal
+
+- if the branch currently checked out in the `~/.propellor` repository does not match `PROPELLOR_SPIN_BRANCH`, Propellor would refuse to spin
+
+- if the `PROPELLOR_DIRTY_NOSPIN` variable is set, Propellor would refuse to spin if the `~/.propellor` repository contains uncommitted changes
+
+# Rationale
+
+`PROPELLOR_SPIN_BRANCH` is to prevent foot-shooting. When working on a feature branch one might forget to check out one's usual config branch before spinning. If the host that is spun is configured with `Cron.runPropellor`, it will be set to pull from the feature branch. If the user doesn't realise that this has happened, they might make further commits to their usual config branch and expect them to have propagated to the host by means of its `Cron.runPropellor` cronjob, but they won't reach the host until the next manual spin from the correct branch. Of course there are other possible foot-shootings available in this area that this environment variable would prevent.
+
+`PROPELLOR_DIRTY_NOSPIN` is to prevent configuration changes ending up in commits made with the undescriptive commit message "propellor spin". I understand that it doesn't bother Joey, but I want all configuration changes to be recorded with a descriptive commit message because it makes using `git revert` and `git cherry-pick` easier. So for users like me this environment variable is a useful check.
+
+--[[spwhitton|https://spwhitton.name]]
+
+> nice work! [[merged|done]] --[[Joey]]
diff --git a/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_1_432c6009fbe2309af81a47658173f753._comment b/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_1_432c6009fbe2309af81a47658173f753._comment
new file mode 100644
index 00000000..9b9ea864
--- /dev/null
+++ b/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_1_432c6009fbe2309af81a47658173f753._comment
@@ -0,0 +1,27 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-12-06T21:14:36Z"
+ content="""
+I'd use `PROPELLOR_SPIN_BRANCH`. No objections to `PROPELLOR_DIRTY_NOSPIN`
+as long as it's not default.
+
+Note that Cron.runPropellor does not use /usr/bin/propellor, and there are
+other ways of running propellor that don't use that wrapper. So I don't
+think the wrapper is the place to implement this kind of thing.
+
+Why use environment variables for configuration? That makes it hard to make
+sure propellor gets the same configuration every way it can be run. And,
+propellor has a config file. :)
+
+Implementation could be something like, add a `configuredMain` that takes a
+monoidial configuration value for such global config settings.
+(so `defaultMain = configuredMain mempty`)
+
+Hmm, I suppose the issue with `PROPELLOR_SPIN_BRANCH` is that when a
+different branch is checked out, that branch's config.hs would not have that
+configured, or would perhaps set it to use that branch. So, that's why
+you were thinking environment variables?
+
+Maybe use git-config?
+"""]]
diff --git a/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_2_3ddaec3927b4a4aefad45a02e83476dc._comment b/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_2_3ddaec3927b4a4aefad45a02e83476dc._comment
new file mode 100644
index 00000000..045cd927
--- /dev/null
+++ b/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_2_3ddaec3927b4a4aefad45a02e83476dc._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 2"
+ date="2015-12-06T22:24:06Z"
+ content="""
+I was thinking environment variables because I saw both of these as just safety checks for the user, spinning hosts from their xterm on their laptop. I'll implement both as `git-config` variables; that's a good idea as it covers more cases.
+
+I don't think that this patch need touch the propellor executable run by `Cron.runPropellor`, because if the check has already ensured that the correct branch got pushed to the host during the most recent spin, then `propellor_cronjob` is guaranteed to pull the correct branch.
+"""]]
diff --git a/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_3_cf7b9d698c67e7a12d07a53667241092._comment b/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_3_cf7b9d698c67e7a12d07a53667241092._comment
new file mode 100644
index 00000000..ca22b1d3
--- /dev/null
+++ b/doc/todo/proposal:_env_vars_PROPELLOR__95__SPIN__95__BRANCH___38___PROPELLOR__95__DIRTY__95__NOSPIN/comment_3_cf7b9d698c67e7a12d07a53667241092._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 3"
+ date="2015-12-06T23:58:51Z"
+ content="""
+I've implemented these in the `safetychecks` branch of `https://git.spwhitton.name/propellor`.
+
+A nice side effect of my implementation is that the spin only errors out after there's been an attempt to compile Propellor. So you can run `propellor --spin` in order to have GHC typecheck your code on a feature branch.
+"""]]
diff --git a/doc/todo/publish_propellor_as_library_to_hackage.mdwn b/doc/todo/publish_propellor_as_library_to_hackage.mdwn
new file mode 100644
index 00000000..709ee35b
--- /dev/null
+++ b/doc/todo/publish_propellor_as_library_to_hackage.mdwn
@@ -0,0 +1,4 @@
+Currently, AFAIK, one needs to fork propellor repo, add its own configuration and compile propellor binary from all the source tree.
+It would be handy and more modular to allow one to have a propellor configuration linked to propellor as a library, hosted on hackage.
+
+> [[done]] --[[Joey]]
diff --git a/doc/todo/publish_propellor_as_library_to_hackage/comment_1_00a865bf7977c0e49f54a365f4b60ce8._comment b/doc/todo/publish_propellor_as_library_to_hackage/comment_1_00a865bf7977c0e49f54a365f4b60ce8._comment
new file mode 100644
index 00000000..8d56f0f1
--- /dev/null
+++ b/doc/todo/publish_propellor_as_library_to_hackage/comment_1_00a865bf7977c0e49f54a365f4b60ce8._comment
@@ -0,0 +1,27 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-02-28T15:01:24Z"
+ content="""
+Unusual as it is for propellor's configuration git repo to include the full
+source code to propellor, I like this approach. It lets users change any
+existing property that is not generic enough, or makes assumptions they
+don't like, or needs porting to their OS of choice.
+
+But still, propellor is
+[on hackage](http://hackage.haskell.org/package/propellor), as
+a library. It can be used that way if you want to.
+
+I don't think that any of propellor's code cares how it's distributed,
+except for src/wrapper.hs (which cabal will install as
+~/.cabal/bin/propellor), which sets up the ~/.propellor/ repository. You
+can bypass using that wrapper if you like, and cabal install propellor and
+create your own ~/.propellor/ repository containing only your own
+config.hs, and build and use propellor that way.
+
+Where that approach becomes a problem is that propellor --spin currently
+relies on propellor's Makefile being in the repository, when bootstrapping
+propellor on a remote host. So you'll need to include a copy of that in
+your repo for --spin to work. I'd like to get rid of the need for the
+Makefile. (Only the build and deps targets are used by --spin.)
+"""]]
diff --git a/doc/todo/publish_propellor_as_library_to_hackage/comment_2_29cc276929020e68eae8ae04110a3f5f._comment b/doc/todo/publish_propellor_as_library_to_hackage/comment_2_29cc276929020e68eae8ae04110a3f5f._comment
new file mode 100644
index 00000000..af61b1db
--- /dev/null
+++ b/doc/todo/publish_propellor_as_library_to_hackage/comment_2_29cc276929020e68eae8ae04110a3f5f._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-02-28T17:08:28Z"
+ content="""
+Ok, I got --spin to not use the Makefile any more. So with the 2.2.0
+release, if you want to make ~/.propellor contain only a config.hs
+file and a foo.cabal file, that will work. The cabal file would contain
+something like:
+
+<pre>
+Executable propellor-config
+ Main-Is: config.hs
+ GHC-Options: -Wall -threaded -O0
+ Build-Depends: propellor, base >= 4.5, base < 5
+</pre>
+"""]]
diff --git a/doc/todo/publish_propellor_as_library_to_hackage/comment_3_efbe0ef77be957c37e745ec64452ae99._comment b/doc/todo/publish_propellor_as_library_to_hackage/comment_3_efbe0ef77be957c37e745ec64452ae99._comment
new file mode 100644
index 00000000..09628e53
--- /dev/null
+++ b/doc/todo/publish_propellor_as_library_to_hackage/comment_3_efbe0ef77be957c37e745ec64452ae99._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmtnXa0F3OsNh8H7yf5EEbtuufPZG-3StI"
+ nickname="Arnaud"
+ subject="You rocks!"
+ date="2015-03-05T15:24:49Z"
+ content="""
+Apologies for wrong information, I did not check if propellor was on hackage. Anyway, thanks a lot for caring to \"fix\" that, will give it a try this week and keep you posted.
+
+Thanks a lot
+"""]]
diff --git a/doc/todo/publish_propellor_as_library_to_hackage/comment_4_6ebf2e30596ddf6eba91717576837019._comment b/doc/todo/publish_propellor_as_library_to_hackage/comment_4_6ebf2e30596ddf6eba91717576837019._comment
new file mode 100644
index 00000000..737e7066
--- /dev/null
+++ b/doc/todo/publish_propellor_as_library_to_hackage/comment_4_6ebf2e30596ddf6eba91717576837019._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmtnXa0F3OsNh8H7yf5EEbtuufPZG-3StI"
+ nickname="Arnaud"
+ subject="Propellor 2.2.0 not on hackage"
+ date="2015-03-08T20:21:42Z"
+ content="""
+So I cannot depend on it right now. Do you know when it will be available there?
+"""]]
diff --git a/doc/todo/publish_propellor_as_library_to_hackage/comment_5_4a4e94c637e0380adc1a43ec3d0633e1._comment b/doc/todo/publish_propellor_as_library_to_hackage/comment_5_4a4e94c637e0380adc1a43ec3d0633e1._comment
new file mode 100644
index 00000000..85f95c17
--- /dev/null
+++ b/doc/todo/publish_propellor_as_library_to_hackage/comment_5_4a4e94c637e0380adc1a43ec3d0633e1._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2015-03-09T17:00:35Z"
+ content="""
+SImply because 2.2.0 had not been released yet. (UNRELEASED in
+changelog..)
+"""]]
diff --git a/doc/todo/publish_propellor_as_library_to_hackage/comment_6_19470170c3ef461f446b0af1d8501640._comment b/doc/todo/publish_propellor_as_library_to_hackage/comment_6_19470170c3ef461f446b0af1d8501640._comment
new file mode 100644
index 00000000..143f1dea
--- /dev/null
+++ b/doc/todo/publish_propellor_as_library_to_hackage/comment_6_19470170c3ef461f446b0af1d8501640._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmtnXa0F3OsNh8H7yf5EEbtuufPZG-3StI"
+ nickname="Arnaud"
+ subject="comment 6"
+ date="2015-03-10T06:28:52Z"
+ content="""
+Sorry, I did not read the changelog. Thanks for all the hard work on propellor.
+"""]]
diff --git a/doc/todo/pull_request:_Git.bareRepoDefaultBranch_property.mdwn b/doc/todo/pull_request:_Git.bareRepoDefaultBranch_property.mdwn
new file mode 100644
index 00000000..038ab876
--- /dev/null
+++ b/doc/todo/pull_request:_Git.bareRepoDefaultBranch_property.mdwn
@@ -0,0 +1,7 @@
+Please consider merging branch `defaultbranch` of repo `https://git.spwhitton.name/propellor`.
+
+This branch adds a new property `Git.bareRepoDefaultBranch` which sets the default branch of a bare repository. This is useful when hosting git repositories that don't have a master branch, so that something gets checked out when someone clones them.
+
+I limited this property to bare repositories since the notion of a default branch for a non-bare repository doesn't really make sense.
+
+> [[merged|done]] --[[Joey]]
diff --git a/doc/todo/pull_request:_Git.repoConfigured_and_Git.repoAcceptsNonFFs_properties.mdwn b/doc/todo/pull_request:_Git.repoConfigured_and_Git.repoAcceptsNonFFs_properties.mdwn
new file mode 100644
index 00000000..c1df5461
--- /dev/null
+++ b/doc/todo/pull_request:_Git.repoConfigured_and_Git.repoAcceptsNonFFs_properties.mdwn
@@ -0,0 +1,13 @@
+Please consider merging branch `repoAcceptsNonFFs` of the repository `https://git.spwhitton.name/propellor`.
+
+This branch adds
+
+- the revertable property `Git.repoAcceptsNonFFs` which sets `receive.denyNonFastForwards` on a repo; and
+- a simple property `Git.repoConfigured` to run `git config` for the above property.
+
+`Git.repoAcceptsNonFFs` is useful for running a git server, hosting repos with `Git.bareRepo`: some of them should be set to accept fast-forwards.
+
+Note that `Git.repoConfigured` uses a tuple instead of just two function arguments in order that it can be used infix in `config.hs` when connected to other properties with `&`, as `ConfFile.containsIniSetting`.
+
+> [[done]], thank you (had to fix some indents) --[[Joey]]
+>> Sorry about that! Thought I had Emacs set up for your style guide. --spwhitton
diff --git a/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties.mdwn b/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties.mdwn
new file mode 100644
index 00000000..b34118f0
--- /dev/null
+++ b/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties.mdwn
@@ -0,0 +1,15 @@
+Please consider merging branch `locale` of repo `https://git.spwhitton.name/propellor`
+
+It adds the following properties:
+
+- `Locale.selectedFor` to choose a locale for a locale variable
+- `Locale.available`, used by `Locale.selectedFor` to ensure a locale is generated
+
+Example usage (I'm British but I live in the US):
+
+ & "en_GB.UTF-8" `Locale.selectedFor` ["LANG", "LANGUAGE"]
+ & "en_US.UTF-8" `Locale.selectedFor` ["LC_PAPER"]
+
+Pretty sure I've got the indentation right this time too ;)
+
+> merged, thanks! [[done]] --[[Joey]]
diff --git a/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties/comment_1_3c528827f40420e3f4001f69127a0c51._comment b/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties/comment_1_3c528827f40420e3f4001f69127a0c51._comment
new file mode 100644
index 00000000..4d413c84
--- /dev/null
+++ b/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties/comment_1_3c528827f40420e3f4001f69127a0c51._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-11-25T15:24:10Z"
+ content="""
+The types here don't tell me much about what values it expects.
+
+`selectedFor :: String -> [String] -> Property NoInfo`
+
+Function needs either some examples in its haddock, or better types.
+
+Also, the `available` property incorrectly succeeds if the locale passed to
+it is not listed in locale.gen.
+
+(It would be nice for these properties to be revertable but that's just a
+thought.)
+"""]]
diff --git a/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties/comment_2_981a305c50d699fd3d06c39ca66107ea._comment b/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties/comment_2_981a305c50d699fd3d06c39ca66107ea._comment
new file mode 100644
index 00000000..e8801aba
--- /dev/null
+++ b/doc/todo/pull_request:_Locale.selectedFor_and_Locale.available_properties/comment_2_981a305c50d699fd3d06c39ca66107ea._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 2"
+ date="2015-11-26T02:51:22Z"
+ content="""
+Thanks for the feedback. I've implemented your suggestions. Please take a look.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable.mdwn b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable.mdwn
new file mode 100644
index 00000000..275ea9f5
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable.mdwn
@@ -0,0 +1,6 @@
+Please consider merging branch `builddepfix` of repo `https://git.spwhitton.name/propellor`
+
+Patches `Apt.buildDep` to check whether the build deps are installable, so that it no longer registers a change every spin.
+
+> Apt.buildDep now checks if the dpkg status file has changed, so [[done]]
+> --[[Joey]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_10_eb58216ef1172ee5b882090dab7219ce._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_10_eb58216ef1172ee5b882090dab7219ce._comment
new file mode 100644
index 00000000..3799a012
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_10_eb58216ef1172ee5b882090dab7219ce._comment
@@ -0,0 +1,32 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 10"""
+ date="2015-12-03T15:05:21Z"
+ content="""
+
+ trivial (trivial p `changesFile` f) `changesFile` f'
+
+The parenthesized property here is all marked trivial, so a change to f
+won't result in MadeChange, though a change to f' will.
+
+The only way propellor might intercept the output of a program is if you're
+using the new Concurrent module. In that case it should buffer program output
+and display it all at once. There could potentially be a bug there that
+hid program output. I certianly can't reproduce changesFile hiding the output
+of a program:
+
+ *Propellor.Property.Apt> runPropellor (Host "localhost" [] mempty) $ ensureProperty $ trivial (buildDep ["git-annex"]) `changesFile` "/var/lib/dpkg/status"
+ Reading package lists... Done
+ Building dependency tree
+ Reading state information... Done
+ 0 upgraded, 0 newly installed, 0 to remove and 707 not upgraded.
+ NoChange
+
+ *Propellor.Property.Apt Propellor.Property.Concurrent> withConcurrentOutput $ runPropellor (Host "localhost" [] mempty) $ ensureProperty $ (trivial (buildDep ["git-annex"]) `changesFile` "/var/lib/dpkg/status") `concurrently` cmdProperty "echo" ["hi"]
+ hi
+ Reading package lists...
+ Building dependency tree...
+ Reading state information...
+ 0 upgraded, 0 newly installed, 0 to remove and 707 not upgraded.
+ MadeChange
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_11_bee4b2397dfb28a3791081a83d725daf._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_11_bee4b2397dfb28a3791081a83d725daf._comment
new file mode 100644
index 00000000..f4df5527
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_11_bee4b2397dfb28a3791081a83d725daf._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 11"
+ date="2015-12-03T23:29:57Z"
+ content="""
+Thank you for your feedback. I'll think about how I might rewrite `changeIfChanges` to avoid that problem with `trivial`, and I'll try to pin down the hiding of apt's output.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_12_1e09f5a3f4565a9392d7b50b703a8a69._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_12_1e09f5a3f4565a9392d7b50b703a8a69._comment
new file mode 100644
index 00000000..3db6fd1b
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_12_1e09f5a3f4565a9392d7b50b703a8a69._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 12"""
+ date="2015-12-05T22:52:42Z"
+ content="""
+I had a thought about this;
+[[trivial is a code smell|type-level_trivial_avoidance]] and adding
+UncheckedProperty type avoids needing to use trivial.
+
+So, now cmdProperty, runApt, and other things that make a Property but
+can't really detect when it MadeChange can instead make an
+UncheckedProperty, and changesFile is one of the ways to convert that into
+a Property.
+
+My implementation also allows applying changesFile multiple times, to
+detect a change to multiple files.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_13_54de6d1c5351e9303c190edda7e7a33f._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_13_54de6d1c5351e9303c190edda7e7a33f._comment
new file mode 100644
index 00000000..72f6bf40
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_13_54de6d1c5351e9303c190edda7e7a33f._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 13"
+ date="2015-12-06T17:17:34Z"
+ content="""
+Very nice. Thank you for writing it up in full so Haskell beginners like me can learn about the flexibilities and limitations of programming with Haskell types.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_1_88f5d79b8cd6064d1a65dec445819afe._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_1_88f5d79b8cd6064d1a65dec445819afe._comment
new file mode 100644
index 00000000..209b62a3
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_1_88f5d79b8cd6064d1a65dec445819afe._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-11-26T11:14:37Z"
+ content="""
+Looks like Build-Depends-Index is not handled, nor are 'a | b' build deps,
+or arch-specific build deps. Since versions are skipped, if a build dep
+needed a newer version, the property also wouldn't try to upgrade to it
+after this change.
+
+I feel that parsing build deps is too complex for propellor.
+
+It might work to somehow detect if apt has made any changes.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_2_23cb35130719bf1657652b76c0791947._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_2_23cb35130719bf1657652b76c0791947._comment
new file mode 100644
index 00000000..ace80098
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_2_23cb35130719bf1657652b76c0791947._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-11-26T12:48:25Z"
+ content="""
+How about simply checking if /var/lib/dpkg/status is changed?
+
+I added a `changesFile` property combinator which should be helpful for
+that.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_3_5759b4fddf360e8a777c0339c5426b40._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_3_5759b4fddf360e8a777c0339c5426b40._comment
new file mode 100644
index 00000000..86f4d1de
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_3_5759b4fddf360e8a777c0339c5426b40._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 3"
+ date="2015-11-26T14:39:31Z"
+ content="""
+I was hoping your deep knowledge of Apt would be able to help with this!
+
+Before I proceed, how would you feel about catching the output of apt and only printing it if apt did make changes? Although that would make the output weirdly appear all at once when the build deps are actually installed, on the other hand it would mean no output if they're not, when we detect no changes to /var/lib/dpkg/status.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_4_cd49645ff94d9ccec74ff72a836cd1f7._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_4_cd49645ff94d9ccec74ff72a836cd1f7._comment
new file mode 100644
index 00000000..30149a4c
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_4_cd49645ff94d9ccec74ff72a836cd1f7._comment
@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2015-11-30T16:57:45Z"
+ content="""
+I think it would probably depend on the user when that makes sense to do.
+If I'm installing build deps over a slow network connection, I'd like to
+see the output.
+
+It would be awesome if this transformation could be applied to any
+arbitrary Property. I don't immediately know how to do that, although it
+seems useful that all process spawning already goes through
+concurrent-output, which can buffer the output and display it only when the
+command finishes.
+
+Perhaps an extension to concurrent-ouput could let it buffer the output
+of all commands run by a property and then discard the buffer if the
+property finished with NoChange. But I don't see a way to make this work
+when multiple properties are being run concurrently.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_5_33744064a8b224d6e44e2cf8081f6a56._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_5_33744064a8b224d6e44e2cf8081f6a56._comment
new file mode 100644
index 00000000..b0283161
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_5_33744064a8b224d6e44e2cf8081f6a56._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 5"
+ date="2015-12-02T04:46:14Z"
+ content="""
+I've made a property combinator `noChangeIfUnchanged` and applied it to Apt.buildDep in my `builddepfix` branch. Please take a look.
+
+In my testing of this, Propellor hides the output if the build deps are already installed i.e. if the property returns NoChange. So it looks like you've already implemented your awesome at some point :)
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_6_db48a08bc6eece590aebd41691623665._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_6_db48a08bc6eece590aebd41691623665._comment
new file mode 100644
index 00000000..85c91d65
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_6_db48a08bc6eece590aebd41691623665._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 6"
+ date="2015-12-02T04:57:57Z"
+ content="""
+Seems I blanked on your `changesFile` combinator when I sat down to write mine. Taking a look now, my approach is much more direct for cases like `Apt.buildDep` when the problem is registering a change when there should be NoChange, whereas I think the intention of your changesFile is the opposite case. Though it might be nice to combine them. Let me know what you think.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_7_9c45f473cbc432a32bd64bbbf048fae4._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_7_9c45f473cbc432a32bd64bbbf048fae4._comment
new file mode 100644
index 00000000..e2611fd5
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_7_9c45f473cbc432a32bd64bbbf048fae4._comment
@@ -0,0 +1,21 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2015-12-02T16:10:34Z"
+ content="""
+The two combinators are indeed very similar. The reason I wrote
+changesFile the way I did is that that allows it to be applied repeatedly
+when a property can change any of several files.
+
+ trivial someprop
+ `changesFile` "foo"
+ `changesFile` "bar"
+
+That seems fairly likely to come up, while it would be unusual for a
+property to have to change multiple files at once to be considered
+to make a change at all, which is what multiple applications of
+`noChangeIfUnchanged` leads to.
+
+But neither combinator causes apt's output to not be displayed,
+which is what I thought we were talking about.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_8_7069f68888663fef109b82a044aeb5e1._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_8_7069f68888663fef109b82a044aeb5e1._comment
new file mode 100644
index 00000000..c05d6255
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_8_7069f68888663fef109b82a044aeb5e1._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 8"
+ date="2015-12-02T21:44:37Z"
+ content="""
+My original goal was to have `Apt.buildDep` return NoChange if the build deps are already installed. As a welcome but unexplained side-effect, on my system `noChangeIfUnchanged` *does* cause apt's output not to be displayed.
+
+I'll think about ways to combine our two combinators.
+"""]]
diff --git a/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_9_5694c0bec217d3513aa8e80f55482d75._comment b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_9_5694c0bec217d3513aa8e80f55482d75._comment
new file mode 100644
index 00000000..5783dd7b
--- /dev/null
+++ b/doc/todo/pull_request:_patch_Apt.buildDep_to_only_proceed_if_installable/comment_9_5694c0bec217d3513aa8e80f55482d75._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 9"
+ date="2015-12-03T02:08:58Z"
+ content="""
+I can get what I want if I use `trivial` and `changesFile` in the way you described. So please consider adding your method as a combinator:
+
+ p `changeIfChanges` f = (trivial p) `changesFile` f
+
+which is okay because `trivial` is idempotent so `changeIfChanges` may be applied more than once (I've got this in my branch with a decent docstring and I've applied it to `Apt.buildDep`).
+
+I think that this ought to be its own combinator, rather than just a recommendation to use `trivial` and `changesFile` in such cases, because this doesn't follow the semantics of `trivial`: it's not necessarily the case that it is the same amount of work to check if the property needs to be ensured as it is to ensure it.
+
+(In this language, my `noChangeIfUnchanged` could be called `changeOnlyIfChanges`. I agree that it's very unlikely to useful.)
+
+(Again, on my machine, applying `changeIfChanges` to `Apt.buildDep` magically hides apt's output if the build-deps are already installed.)
+"""]]
diff --git a/doc/todo/pull_request:_reproducible___47__usr__47__src__47__propellor__47__propellor.git.mdwn b/doc/todo/pull_request:_reproducible___47__usr__47__src__47__propellor__47__propellor.git.mdwn
new file mode 100644
index 00000000..0e122ddc
--- /dev/null
+++ b/doc/todo/pull_request:_reproducible___47__usr__47__src__47__propellor__47__propellor.git.mdwn
@@ -0,0 +1,9 @@
+Please consider merging branch `reproducible` of repository `https://git.spwhitton.name/propellor`.
+
+This makes the generated `/usr/src/propellor/propellor.git` reproducible, so that the whole Debian package can be built reproducibly.
+
+So far as I can tell, this is the only part of the propellor build that is not reproducible at present. It's also the only issue listed on the [[reproducible builds team website|https://reproducible.debian.net/rb-pkg/unstable/amd64/propellor.html]].
+
+--spwhitton
+
+> merged; [[done]] --[[Joey]]
diff --git a/doc/todo/pull_request:_reproducible___47__usr__47__src__47__propellor__47__propellor.git/comment_1_d1ed8af3172ada81d166063f0b38e23a._comment b/doc/todo/pull_request:_reproducible___47__usr__47__src__47__propellor__47__propellor.git/comment_1_d1ed8af3172ada81d166063f0b38e23a._comment
new file mode 100644
index 00000000..1af7a9e6
--- /dev/null
+++ b/doc/todo/pull_request:_reproducible___47__usr__47__src__47__propellor__47__propellor.git/comment_1_d1ed8af3172ada81d166063f0b38e23a._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-01-18T17:17:55Z"
+ content="""
+I've merged that, thanks.
+
+IIRC, ghc only produces reproducible output when not doing any parallel
+building. If that is currently avoided, it's probably only by accident.
+It might be worth forcing -j1 when building the debian package.
+"""]]
diff --git a/doc/todo/revertable_Ssh.authorizedKey.mdwn b/doc/todo/revertable_Ssh.authorizedKey.mdwn
new file mode 100644
index 00000000..79c59bcc
--- /dev/null
+++ b/doc/todo/revertable_Ssh.authorizedKey.mdwn
@@ -0,0 +1,3 @@
+I recently lost the security key I store my primary SSH key on, and had to remove that key from all authorized_keys files I had access to. It would be great if Ssh.authorizedKey was revertable, so that this could be done simply by adding a ! before existing Ssh.authorizedKey lines.
+
+> [[done]] --[[Joey]]
diff --git a/doc/todo/revertable_Ssh.authorizedKey/comment_1_6c11976a814a7f4a830bc11ae9bf534e._comment b/doc/todo/revertable_Ssh.authorizedKey/comment_1_6c11976a814a7f4a830bc11ae9bf534e._comment
new file mode 100644
index 00000000..e03f1143
--- /dev/null
+++ b/doc/todo/revertable_Ssh.authorizedKey/comment_1_6c11976a814a7f4a830bc11ae9bf534e._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-06T19:01:13Z"
+ content="""
+This should be easy enough to implement; just implement a property that
+ensures the file lacks an authorized key (probably using `File.lacksLine`)
+and then combine the two properties with `<!>` to get a RevertableProperty.
+
+I'd accept a patch that does that.
+"""]]
diff --git a/doc/todo/revertable_Ssh.authorizedKey/comment_2_5b5c8217eeb48159109b453197694db3._comment b/doc/todo/revertable_Ssh.authorizedKey/comment_2_5b5c8217eeb48159109b453197694db3._comment
new file mode 100644
index 00000000..ddadd4f4
--- /dev/null
+++ b/doc/todo/revertable_Ssh.authorizedKey/comment_2_5b5c8217eeb48159109b453197694db3._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="mithrandi@311efa1b2b5c4999c2edae7da06fb825899e8a82"
+ nickname="mithrandi"
+ subject="comment 2"
+ date="2016-02-26T13:06:38Z"
+ content="""
+Ssh.unauthorizedKey exists now; is there a reason not to add it to authorizedKey to make it revertable?
+"""]]
diff --git a/doc/todo/revertable_Ssh.authorizedKey/comment_3_54b1c00246663c845a1b919ccdc168fd._comment b/doc/todo/revertable_Ssh.authorizedKey/comment_3_54b1c00246663c845a1b919ccdc168fd._comment
new file mode 100644
index 00000000..e6ba53cb
--- /dev/null
+++ b/doc/todo/revertable_Ssh.authorizedKey/comment_3_54b1c00246663c845a1b919ccdc168fd._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-02-26T14:56:36Z"
+ content="""
+No particular reason. I've made the change.
+"""]]
diff --git a/doc/todo/should_not_overwrite_unchanged_private_files.mdwn b/doc/todo/should_not_overwrite_unchanged_private_files.mdwn
new file mode 100644
index 00000000..090849f1
--- /dev/null
+++ b/doc/todo/should_not_overwrite_unchanged_private_files.mdwn
@@ -0,0 +1 @@
+A private file is overwritten by propellor at each run. It is not optimal when the host runs an integrity checker (like samhain). It would be great to have a file modified only if necessary.
diff --git a/doc/todo/should_not_overwrite_unchanged_private_files/comment_1_d65fd2ebfca6b9994db9512232ce78ff._comment b/doc/todo/should_not_overwrite_unchanged_private_files/comment_1_d65fd2ebfca6b9994db9512232ce78ff._comment
new file mode 100644
index 00000000..6e44dde6
--- /dev/null
+++ b/doc/todo/should_not_overwrite_unchanged_private_files/comment_1_d65fd2ebfca6b9994db9512232ce78ff._comment
@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-12-11T16:35:43Z"
+ content="""
+Doesn't rebuilding propellor overwrite lots of files too? Is the
+privdata.local file somehow a particular problem, perhaps becuase
+of its permissions?
+
+You should find it easy enough to make propellor read any existing
+file and only update the file when there are changes. But it seems to me
+your integrity checker would still go off whenever a new version
+of the file is legitimately reveiced. Perhaps it would be better to
+write a property to configure your integrity checker to not fire on
+this file?
+
+(I've thought from time to time about having rsync update the privdata.local
+file. Since it's unchanged in most spins, that would probably save network
+bandwidth.)
+"""]]
diff --git a/doc/todo/should_not_overwrite_unchanged_private_files/comment_2_2e37e89b8f108f027d2d8c5962a24536._comment b/doc/todo/should_not_overwrite_unchanged_private_files/comment_2_2e37e89b8f108f027d2d8c5962a24536._comment
new file mode 100644
index 00000000..dbf7ac3b
--- /dev/null
+++ b/doc/todo/should_not_overwrite_unchanged_private_files/comment_2_2e37e89b8f108f027d2d8c5962a24536._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="gueux"
+ subject="comment 2"
+ date="2015-12-13T20:44:20Z"
+ content="""
+The integrity checker should shout everytime it finds a new version of a file (and if a new version of the file is legitimately received, I can then run \"samhain -t update -m none --interactive\"). As the private files are very often sensitive information, the integrity should shout on them too. To me, it sounds like it should be the default (it may also be useful for backup systems that check when a file was last modified?), but I dont see exactly what should be changed to enable that. What do you think?
+
+Having privdata uploaded only if it is updated would certainly be cool for slow internet connections.
+"""]]
diff --git a/doc/todo/should_not_overwrite_unchanged_private_files/comment_3_5e7127049c1798dfc830d33da0fd78d7._comment b/doc/todo/should_not_overwrite_unchanged_private_files/comment_3_5e7127049c1798dfc830d33da0fd78d7._comment
new file mode 100644
index 00000000..b2de7f4a
--- /dev/null
+++ b/doc/todo/should_not_overwrite_unchanged_private_files/comment_3_5e7127049c1798dfc830d33da0fd78d7._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-12-14T02:03:40Z"
+ content="""
+The place the privdata file gets saved is Spin.hs, when `update`
+calls "writeFileProtected privfile"
+"""]]
diff --git a/doc/todo/silence_xargs_when_hothasktags_not_installed.mdwn b/doc/todo/silence_xargs_when_hothasktags_not_installed.mdwn
new file mode 100644
index 00000000..efa17987
--- /dev/null
+++ b/doc/todo/silence_xargs_when_hothasktags_not_installed.mdwn
@@ -0,0 +1,9 @@
+Please consider merging branch `hothasktags` of my repo `https://git.spwhitton.name/propellor`
+
+Moves the `2>/dev/null` redirection in the Makefile rule for `tags` in order to silence xargs if hothasktags is not installed (avoids `xargs: hothasktags: No such file or directory`).
+
+I assume that your originally intention was not to cause an error if hothasktags is not installed, since you have `|| true` at the end of the line. However, someone trying to build propellor's Debian package saw the error output from xargs and thought it meant hothasktags should be a build-dep. This patch prevents someone thinking that.
+
+-- [[spwhitton|https://spwhitton.name]]
+
+> [[merged|done]] --[[Joey]]
diff --git a/doc/todo/spin_and_ipv6_addresses.mdwn b/doc/todo/spin_and_ipv6_addresses.mdwn
new file mode 100644
index 00000000..602d311b
--- /dev/null
+++ b/doc/todo/spin_and_ipv6_addresses.mdwn
@@ -0,0 +1,9 @@
+Currently, --spin uses Network.BSD to look up IPv4 addresses of hostnames.
+Not Ipv6.
+
+This doesn't prevent using propellor with IPv6 only hosts. But it prevents
+using short names for such hosts with --spin. And, propellor only looks at
+configured ipv4 properties of a host when deciding if the DNS hostname is
+out of date, and falling back to contacting the host by IPv6 address.
+
+> [[fixed|done]] --[[Joey]]
diff --git a/doc/todo/spin_without_remote_compilation.mdwn b/doc/todo/spin_without_remote_compilation.mdwn
new file mode 100644
index 00000000..6ccc6414
--- /dev/null
+++ b/doc/todo/spin_without_remote_compilation.mdwn
@@ -0,0 +1 @@
+In some cases, building Propellor on the target machine is undesireable; for example, the host has limited memory available, or the load imposed by GHC on CPU / I/O usage is unacceptably disruptive to other services running on the host. When spinning from a compatible host, Propellor could instead have an option to copy the locally-built binary to the target host. I'm not sure exactly how to determine "compatible" in this case, so it would probably have to be left to the user to determine whether they can do it or not.
diff --git a/doc/todo/spin_without_remote_compilation/comment_1_10d797b43df9252c34a02c3fd249374b._comment b/doc/todo/spin_without_remote_compilation/comment_1_10d797b43df9252c34a02c3fd249374b._comment
new file mode 100644
index 00000000..6c6f3b6f
--- /dev/null
+++ b/doc/todo/spin_without_remote_compilation/comment_1_10d797b43df9252c34a02c3fd249374b._comment
@@ -0,0 +1,45 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-16T16:05:44Z"
+ content="""
+This is already implemented in propellor, but is currently only used
+when the remote host doesn't have git installed and apt fails to install
+it. I've used it for converting non-Debian systems to Debian eg.
+See Propellor.Spin.sendPrecompiled
+
+Going beyond what's there now is not a feature I need myself, and not a
+priority for me to implement, but I can help to some extent if you're going
+to work on it.
+
+Both the controller and host architecture matter of course in determining
+whether it will work. For example, an i386 controller will produce a
+propellor bundle that works on amd64. An amd64 controller's bundle *may*
+work on an i386 host, but only if its hardware and kernel happen to support
+64 bit. The simplest solution I can think of is to send the precompiled
+binary over to the host and check if it runs there before replacing any
+older propellor binary with it.
+
+The other question is, how to tell propellor when to use this mode. Some
+ideas, which build on each other.
+
+* --spin --precompiled
+
+* Add a `precompiled` property to the host that needs precompiled propellor.
+ The property can set Info, which --spin can look at to know if it needs
+ to use sendPrecompiled for this host, without needing --precompiled
+
+* Could also add a property that says a host is the controller for other
+ hosts. So, anytime propellor is run on the controller host, it
+ automatically spins the other hosts. And if the hosts it's spinning
+ have the `precompiled` property, the controller will honor it.
+
+Note that propellor's cron job will probably fail on a precompiled host,
+since even if it manages to pull changes from the central git repo
+(unlikely as a precompiled propellor currently isn't set up as a git repo),
+it can't locally compile them.
+
+So, in order to have a centralized repository with precompiled hosts,
+you need a controller that can handle sending the updated builds of
+propellor to them.
+"""]]
diff --git a/doc/todo/spin_without_remote_compilation/comment_2_1c3176559695d33bd7e183b9734e430f._comment b/doc/todo/spin_without_remote_compilation/comment_2_1c3176559695d33bd7e183b9734e430f._comment
new file mode 100644
index 00000000..3f6bf4a7
--- /dev/null
+++ b/doc/todo/spin_without_remote_compilation/comment_2_1c3176559695d33bd7e183b9734e430f._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-10-16T18:23:21Z"
+ content="""
+Since the controller idea was useful beyond supporting precompiled hosts,
+I've implemented it first, in Propellor.Property.Spin.controller.
+"""]]
diff --git a/doc/todo/spin_without_remote_compilation/comment_3_3b1053891d1bd9c424f1b517a4686e5d._comment b/doc/todo/spin_without_remote_compilation/comment_3_3b1053891d1bd9c424f1b517a4686e5d._comment
new file mode 100644
index 00000000..096d20aa
--- /dev/null
+++ b/doc/todo/spin_without_remote_compilation/comment_3_3b1053891d1bd9c424f1b517a4686e5d._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 3"
+ date="2016-05-14T01:37:11Z"
+ content="""
+This feature has become more poignant with propellor v3's increased memory requirements.
+"""]]
diff --git a/doc/todo/spin_without_remote_compilation/comment_4_0e98f5ea8af2e14ead239e5b777afb26._comment b/doc/todo/spin_without_remote_compilation/comment_4_0e98f5ea8af2e14ead239e5b777afb26._comment
new file mode 100644
index 00000000..28307a2d
--- /dev/null
+++ b/doc/todo/spin_without_remote_compilation/comment_4_0e98f5ea8af2e14ead239e5b777afb26._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-05-21T17:06:37Z"
+ content="""
+There's a patch implementing this now, in:
+
+ https://git.gueux.org/propellor.git precompiled
+
+I have not found the increased memory too onerous, it's still working
+down to 500 mb cheap VMs. So I'm looking for details about cases where
+it causes ghc to use too much memory.
+<http://propellor.branchable.com/forum/recent_propellor_snapshots_cause_ghc_OOMs/>
+"""]]
diff --git a/doc/todo/ssh__95__user_+_sudo/comment_4_7fc635a8d6e4c903eaefa7383d2c37ac._comment b/doc/todo/ssh__95__user_+_sudo/comment_4_7fc635a8d6e4c903eaefa7383d2c37ac._comment
new file mode 100644
index 00000000..af5e120a
--- /dev/null
+++ b/doc/todo/ssh__95__user_+_sudo/comment_4_7fc635a8d6e4c903eaefa7383d2c37ac._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://launchpad.net/~jml"
+ nickname="jml"
+ subject="comment 4"
+ date="2015-05-15T08:57:04Z"
+ content="""
+Just want to add that it's not only a security issue: it's also a convenience issue. Many machines are configured by default to not allow remote root logins, but to allow user logins followed by sudo. If propellor can't do that, then there's an extra step in the whole process that can't be easily automated within propellor.
+"""]]
diff --git a/doc/todo/ssh_hostkey_Info.mdwn b/doc/todo/ssh_hostkey_Info.mdwn
index a7f8a66a..70c88339 100644
--- a/doc/todo/ssh_hostkey_Info.mdwn
+++ b/doc/todo/ssh_hostkey_Info.mdwn
@@ -5,3 +5,5 @@
the PrivData, and instead configured using the info.
Getting the ssh host key into the info will allow automatically
exporting it via DNS (SSHFP record)
+
+[[done]]; although I did not implement SSHFTP yet, it should be doable now.
diff --git a/doc/todo/support_tarball_source_images.mdwn b/doc/todo/support_tarball_source_images.mdwn
new file mode 100644
index 00000000..13796623
--- /dev/null
+++ b/doc/todo/support_tarball_source_images.mdwn
@@ -0,0 +1,5 @@
+It would be nice to support tarball source images (such as those generated by [buildroot](http://buildroot.org/)). Basically, instead of running debootstrap, just `tar xf` to the right directory.
+
+Having propellor generate the buildroot would be nice as well, but isn't needed right away.
+
+> [[merged|done]] --[[Joey]]
diff --git a/doc/todo/support_tarball_source_images/comment_1_6c019767a6a678d7d9f7ad924e948d94._comment b/doc/todo/support_tarball_source_images/comment_1_6c019767a6a678d7d9f7ad924e948d94._comment
new file mode 100644
index 00000000..192c1a69
--- /dev/null
+++ b/doc/todo/support_tarball_source_images/comment_1_6c019767a6a678d7d9f7ad924e948d94._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2015-10-20T16:06:52Z"
+ content="""
+I've introduced a ChrootBootstrapper type class, of which Debootstrapped
+is just one member. Everything that bootstraps chroots uses this
+type class, so you can write a separate module that uses buildroot, or
+whatever. And you're welcome to contribute such a module to propellor.
+
+As far as having propellor generate a tarball of a chroot, the way to do
+that is something like:
+
+ chroot dir `onChange` mktarball dir
+
+Ie, compose the chroot creation property with one that tars it up.
+"""]]
diff --git a/doc/todo/support_tarball_source_images/comment_2_2d620f837f825f3041d9c66612e2ab4c._comment b/doc/todo/support_tarball_source_images/comment_2_2d620f837f825f3041d9c66612e2ab4c._comment
new file mode 100644
index 00000000..9da5739e
--- /dev/null
+++ b/doc/todo/support_tarball_source_images/comment_2_2d620f837f825f3041d9c66612e2ab4c._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-10-20T16:27:07Z"
+ content="""
+I've done all I plan to do about this particular todo, so look forward to
+modules being contributed for other ways to bootstrap chroots.
+"""]]
diff --git a/doc/todo/support_tarball_source_images/comment_3_411e4884c47fa6c371e6c6d2c5472752._comment b/doc/todo/support_tarball_source_images/comment_3_411e4884c47fa6c371e6c6d2c5472752._comment
new file mode 100644
index 00000000..65027028
--- /dev/null
+++ b/doc/todo/support_tarball_source_images/comment_3_411e4884c47fa6c371e6c6d2c5472752._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://mathstuf.id.fedoraproject.org/"
+ nickname="mathstuf"
+ subject="comment 3"
+ date="2015-10-21T03:57:19Z"
+ content="""
+Here's my attempt at adding support for this: <https://github.com/mathstuf/propellor/tree/add-tarball-system>. `MinimalTarball` may be too verbose. Maybe `TarballImage`?
+"""]]
diff --git a/doc/todo/support_tarball_source_images/comment_4_df41bdafff9277fb105ea2da0b0af5d9._comment b/doc/todo/support_tarball_source_images/comment_4_df41bdafff9277fb105ea2da0b0af5d9._comment
new file mode 100644
index 00000000..21c39d32
--- /dev/null
+++ b/doc/todo/support_tarball_source_images/comment_4_df41bdafff9277fb105ea2da0b0af5d9._comment
@@ -0,0 +1,37 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2015-10-21T21:07:53Z"
+ content="""
+I don't think it makes sense to add MinimalTarball as an operating System.
+
+If you make ChrootTarball contain the FilePath to the tarball,
+then ChrootBootstrapper ChrootTarball instance doesn't need to look
+at the system parameter at all; instead it can just look inside the
+ChrootTarball to get the path to it, and extract that.
+
+So, the user would write, say:
+
+ bootstrapped (System (Debian Unstable) "amd64") (ChrootTarball "/tmp/debian.tar.gz") "/chroot"
+
+What might make sense it to change the first parameter of boostrapped
+to Maybe System, for cases where you don't want to specify it.
+
+----
+
+It would probably also be good to document what kind of tarball is
+expected. Ie, that it can be compressed, and should not consist
+of a single subdirectory, but one subdirectory for each top-level
+root directory.
+
+----
+
+Also, as a minor point, I don't think you need to pass standardPathEnv;
+it should be fine to use boolSystem with the regular enviroment as
+far as I can see. In fact, you could probably simplify extractTarball
+by implementing it like this:
+
+ check (unpopulated target) $
+ cmdProperty "tar" params
+ `requires` File.dirExists target
+"""]]
diff --git a/doc/todo/support_tarball_source_images/comment_5_fec2c4bf3d0ea806c94b0720b5e80aea._comment b/doc/todo/support_tarball_source_images/comment_5_fec2c4bf3d0ea806c94b0720b5e80aea._comment
new file mode 100644
index 00000000..4b999d73
--- /dev/null
+++ b/doc/todo/support_tarball_source_images/comment_5_fec2c4bf3d0ea806c94b0720b5e80aea._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://mathstuf.id.fedoraproject.org/"
+ nickname="mathstuf"
+ subject="comment 5"
+ date="2015-10-23T03:13:55Z"
+ content="""
+Updated. Thanks for the review. Much cleaner now :) .
+"""]]
diff --git a/doc/todo/support_tarball_source_images/comment_6_7f06f7f03d943649d24b8c5708bbb952._comment b/doc/todo/support_tarball_source_images/comment_6_7f06f7f03d943649d24b8c5708bbb952._comment
new file mode 100644
index 00000000..0de08eb7
--- /dev/null
+++ b/doc/todo/support_tarball_source_images/comment_6_7f06f7f03d943649d24b8c5708bbb952._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2015-10-23T05:31:07Z"
+ content="""
+Came out very nice indeed. Merged, thanks!
+"""]]
diff --git a/doc/todo/systemd_unit_integration.mdwn b/doc/todo/systemd_unit_integration.mdwn
new file mode 100644
index 00000000..6714ef08
--- /dev/null
+++ b/doc/todo/systemd_unit_integration.mdwn
@@ -0,0 +1 @@
+Properties for systemd unit files and support for dropping new units (e.g., a custom `.timer` unit) in should be supported. Support for `systemd-networkd` setup would be nice as well.
diff --git a/doc/todo/systemd_unit_integration/comment_1_cc7f255bc8ca5a6e46f0f08889ceac06._comment b/doc/todo/systemd_unit_integration/comment_1_cc7f255bc8ca5a6e46f0f08889ceac06._comment
new file mode 100644
index 00000000..73f3ead5
--- /dev/null
+++ b/doc/todo/systemd_unit_integration/comment_1_cc7f255bc8ca5a6e46f0f08889ceac06._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="https://mathstuf.id.fedoraproject.org/"
+ nickname="mathstuf"
+ subject="comment 1"
+ date="2015-10-25T19:39:51Z"
+ content="""
+Oh, useful links:
+
+[Arch wiki](https://wiki.archlinux.org/index.php/Systemd-networkd#Usage_with_containers) [CoreOS blog post](https://coreos.com/blog/intro-to-systemd-networkd/)
+"""]]
diff --git a/doc/todo/type-level_trivial_avoidance.mdwn b/doc/todo/type-level_trivial_avoidance.mdwn
new file mode 100644
index 00000000..797a1f8e
--- /dev/null
+++ b/doc/todo/type-level_trivial_avoidance.mdwn
@@ -0,0 +1,92 @@
+The `trivial` property combinator is a bit of a code smell. It's almost
+always better for a property to do the work to return MadeChange
+accurately. While it doesn't matter if a property directly attached to a
+Host is trivial, it can matter a great deal when eg, a disk image needs to
+be regenerated when a property makes a change to the source chroot.
+
+So, I'd like to move propellor to having all properties return an accurate
+MadeChange. Of course, it's up to the implementation to get that right, but
+avoiding `trivial` would go a long way.
+
+At the same time, it's sometimes useful to use trivial along the way to a
+non-trivial property.
+
+ trivial (cmdProperty "apt-get" ["-y", "install", "foo"])
+ `changesFile` "/var/lib/dpkg/status"
+
+Here the cmdProperty normally returns MadeChange, so trivial is used to
+throw that innaccurate value away and the changesFile combinator checks for
+changes.
+
+(The alternative would be for cmdProperty to normally return NoChange, and
+then have changesFile cause MadeChange to be returned. However, this
+approach has plenty of foot-shooting potential of its own, for example
+using cmdProperty and forgetting to check if it made any changes. If
+trivial is a code smell, making cmdProperty and similar generic property
+building tools trivial by default is surely not good..)
+
+----
+
+## So, could this be fixed at the type level?
+
+----
+
+### UncheckedProperty as an alternative to Property
+
+Perhaps it would make sense to
+have a UncheckedProperty, which could be used for things like
+`cmdProperty`. Combinators like `changesFile` would convert it to a
+Property.
+
+(A `trivial` combinator could still be written of course, but it wouldn't be
+necessary in cases like the above example anymore, so it would be more
+clearly a code smell to use `trivial`.)
+
+If UncheckedProperty was added, we'd want all the usual property
+combinators to also work with it. Including `requires`. This is entirely
+doable, but it's going to need quite a lot of duplicated code.
+
+For instance, there are 4 instances currently to handle combining properties
+with and without info; here's one of them:
+
+ instance Combines (Property HasInfo) (Property HasInfo) where
+ combineWith f _ (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
+ IProperty d1 (f a1 a2) i1 (y : cs1)
+
+Adding UncheckedProperty to the mix, we need another 4 instances for combining
+two of those. Plus 4 more for Property + UncheckedProperty = UncheckedProperty.
+Plus 4 more for combining UncheckedProperty + Property! Each of those instances
+has to be implemented separately. The code duplication doesn't stop at
+instances; also need constructors for UncheckedProperty, etc.
+
+### extending Property
+
+Another approach would be `Property i Unchecked|Checked`. But that seems
+overcomplicating for the end user, since most properties that users will
+deal with are not checked.
+
+### minimal UncheckedProperty
+
+Maybe add UncheckedProperty, but without the combining instances?
+
+How about this simple interface:
+
+ unchecked :: Property i -> UncheckedProperty i
+
+ checkResult :: ResultCheckable p => IO a -> (a -> IO Result) -> p i -> Property i
+
+ -- Both Property and UncheckedProperty are ResultCheckable.
+
+ changesFile :: Checkable p => p i -> FilePath -> Property i
+ changesFile p f = checkWith getstat comparestat p
+ where
+ getstat = ...
+ comparestat old = do
+ new <- getstat
+ return $ if old == new then MadeChange else NoChange
+
+Then, cmdProperty would construct a regular property, but apply `unchecked`
+to it. Users of `cmdProperty` would need to apply changesFile or a similar
+check to it before combining it with any other properties.
+
+> Yes, let's go this way. [[done]] --[[Joey]]
diff --git a/doc/todo/type_level_OS_requirements.mdwn b/doc/todo/type_level_OS_requirements.mdwn
new file mode 100644
index 00000000..fed1b279
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements.mdwn
@@ -0,0 +1,56 @@
+Currently, properties don't indicate what OS, or OS's, they work with.
+
+Using `withOS` means throwing a runtime error on an unsupported OS. Yuck.
+
+Could the OS of a property be lifted to the type level?
+
+If we had `Property i '[OS]` then combining properties would need to update
+the type-level OS list.
+
+For example, `Property i '[Debian, FreeBSD]` combined with `Property i '[Debian, Buntish]`
+yields a `Property i '[Debian]` -- the intersection of the OS's supported by
+the combined properties.
+
+And, combining two properties that demand different OS's would need to be a
+type error.
+
+Another kind of property combination would be to glue two properties that
+support different OS's together, yielding a property that supports both,
+and so has both in its '[OS] type list, and that choses which to run using
+withOS.
+
+The `os` property would need to yield a `Property (os:[])`, where the type
+level list contains a type-level eqivilant of the value passed to the
+property. Is that possible to do?
+Or, alternatively, could have less polymorphic `osDebian` etc
+properties replace the `os` property.
+
+If a Host's list of properties, when all combined together,
+contains more than one element in its '[OS], that could be a type error,
+the OS of the Host is indeterminite. Which would be fixed by using the `os`
+property to specify.
+
+On the other hand, if a Host's list of properties yields a single OS
+the type needs to be just `Host`.
+After all, propellor operates on a `[Host]`; if we had `Host OS`,
+the list couldn't contain host's with different OS's.
+
+One way to do this would be to make a Host not contain a Property, but a
+Propellor Result. The list of Properties could be combined together, and
+the Propellor Result extracted from the resulting single property.
+
+----
+
+This is somewhat similar to [[type_level_port_conflict_detection]].
+
+----
+
+Note that propellor needs to remain buildable with Debian stable's
+ghc 7.6.3. I was able to get the type level OS implementation backported to
+work with that version, with some added ugliness.
+
+--[[Joey]]
+
+[[!tag user/joey]]
+
+> [[done]]!! --[[Joey]]
diff --git a/doc/todo/type_level_OS_requirements/comment_10_b0203dee6e00ea956b10ccfdaf3934f7._comment b/doc/todo/type_level_OS_requirements/comment_10_b0203dee6e00ea956b10ccfdaf3934f7._comment
new file mode 100644
index 00000000..f4c6a8a7
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_10_b0203dee6e00ea956b10ccfdaf3934f7._comment
@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 10"""
+ date="2016-03-20T17:29:48Z"
+ content="""
+The list of child properties is a problem, because it would need to be
+`[Property proptypes]` and the proptypes will vary, so heterogenious list.
+
+The proptypes of the child properties needs to influence the proptypes of
+the parent anyway. Take intersection of the parent's targets and its
+children's targets, plus both's non-target types.
+
+So, could calculate that proptypes, and use it as the type of both the
+parent property, and each child property in the list.
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_1_507e3b74c2a3b8f41da5d3eddf197c6f._comment b/doc/todo/type_level_OS_requirements/comment_1_507e3b74c2a3b8f41da5d3eddf197c6f._comment
new file mode 100644
index 00000000..b282e61e
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_1_507e3b74c2a3b8f41da5d3eddf197c6f._comment
@@ -0,0 +1,75 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-03-08T07:31:51Z"
+ content="""
+ensureProperty presents a problem. Its type would become something like
+this:
+
+ ensureProperty :: Property NoInfo '[OS] -> Propellor Result
+
+So, using ensureProperty inside a Property would not make the outer
+Property inherit the OS requirements of the inner properties.
+
+I don't see a way to propigate the '[OS] out to the outer Property
+from the Propellor monad where ensureProperty is used.
+
+Hmm, perhaps the outer Property's '[OS] could be reified and passed into
+ensureProperty. Then reflect it back to a type, and require that inner
+Property's '[OS] contains everything in the outer '[OS] list.
+
+I'm still vague on reifying and reflecting types, so I don't know if
+this can be done in a way that lets the type checker detect errors.
+
+Something like this, maybe:
+
+ debian :: '[Debian]
+ debian = undefined
+
+ foo :: Property NoInfo '[Debian]
+ foo = reify debian $ \os -> mkproperty os "foo" $ do
+ os <- getOSList
+ ensureProperty os (Pkg.install "bar" :: Property NoInfo '[FreeBSD])
+ -- type error; FreeBSD not in '[Debian]
+
+Where getOSList would pull the `debian` value out of Propellor monad
+state. (Of course, ensureProperty could run getReifiedOSList itself,
+`os` is only passed explicitly for illustration.)
+
+The type of `mkproperty` thus reflects the reified type passed into it.
+Here's a demo showing how to do that:
+
+ demo :: (Reifies s t) => proxy s -> (Bool, t)
+ demo p = (True, reflect p)
+
+ *Main> :t (reify "foo") demo
+ (reify "foo") demo :: (Bool, [Char])
+ *Main> :t (reify False) demo
+ (reify False) demo :: (Bool, Bool)
+
+Similary:
+
+ mkproperty :: (Reifies s os) => proxy s -> Desc -> Propellor Result -> Property NoInfo os
+ mkproperty os desc a = Property desc $ do
+ setOSList (reflect os)
+ a
+
+As for ensureProperty, something like this could work for the
+implementation:
+
+ ensureProperty :: '[OS] -> Property Noinfo -> Propellor Result
+ ensureProperty outeros p@(Property NoInfo inneros)
+ | (reify inneros $ \t1 -> reify outeros $ \t2 -> checkUnification t1 t2) = do
+ ...
+ | otherwise = error "type checker should never let this be reached"
+
+ checkUnification
+ :: (Reifies s1 t1, Reifies s2 t2, TypesUnify t1 t2)
+ => proxy1 s1
+ -> proxy2 s2
+ -> Bool
+ checkUnification _ _ = True -- all done at type level
+
+ type family TypesUnify t1 t2
+ ...
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_2_5a1c0c54db25b039eda28e213e1e6263._comment b/doc/todo/type_level_OS_requirements/comment_2_5a1c0c54db25b039eda28e213e1e6263._comment
new file mode 100644
index 00000000..27aaf0cd
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_2_5a1c0c54db25b039eda28e213e1e6263._comment
@@ -0,0 +1,43 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2016-03-08T18:44:25Z"
+ content="""
+I've made a typed-os-requirements branch that has type-level
+OS lists implemented.
+
+For example:
+
+ *Propellor.Types.OS.TypeLevel> let l = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike
+ *Propellor.Types.OS.TypeLevel> l
+ OSList [OSDebian,OSFreeBSD]
+ *Propellor.Types.OS.TypeLevel> :t l
+ l :: OSList
+ (IntersectOSList
+ '[] '['OSDebian, 'OSFreeBSD] '['OSDebian, 'OSBuntish, 'OSFreeBSD])
+
+What this is lacking is type-level equality for OSList.
+The complicated type above should be equivilant to `OSList '[OSDebian, OSFreeBSD]`
+
+So, this doesn't type check yet:
+
+ foo :: OSList '[OSDebian, OSFreeBSD]
+ foo = (debian `combineSupportedOS` freeBSD ) `intersectSupportedOS` unixlike
+
+ src/Propellor/Types/OS/Typelevel.hs:47:46:
+ Couldn't match expected type ‘IntersectOSList
+ '[]
+ '['OSDebian, 'OSFreeBSD]
+ '['OSDebian, 'OSBuntish, 'OSFreeBSD]’
+ with actual type ‘'['OSDebian, 'OSFreeBSD]’
+ In the expression:
+ (debian `combineSupportedOS` freeBSD)
+ `intersectSupportedOS` unixlike
+ In an equation for ‘foo’:
+ foo
+ = (debian `combineSupportedOS` freeBSD)
+ `intersectSupportedOS` unixlike
+
+Also, `intersectSupportedOS` should have an additional constraint,
+to prevent it from generating an empty type-level list.
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_3_124ceb79eaa4eacc9636147dde4c262c._comment b/doc/todo/type_level_OS_requirements/comment_3_124ceb79eaa4eacc9636147dde4c262c._comment
new file mode 100644
index 00000000..230eccab
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_3_124ceb79eaa4eacc9636147dde4c262c._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2016-03-08T21:06:08Z"
+ content="""
+Asked about what I'm stuck on:
+<http://stackoverflow.com/questions/35878018/how-to-write-an-intersection-function-for-type-level-lists>
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_4_8d14bbbec4e219015a80f80bf6124181._comment b/doc/todo/type_level_OS_requirements/comment_4_8d14bbbec4e219015a80f80bf6124181._comment
new file mode 100644
index 00000000..5db7b68b
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_4_8d14bbbec4e219015a80f80bf6124181._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-03-08T21:19:01Z"
+ content="""
+Ok, got intersectSupportedOS fixed.
+
+ *Propellor.Types.OS.TypeLevel> :t (intersectSupportedOS (combineSupportedOS freeBSD debian) debian)
+ (intersectSupportedOS (combineSupportedOS freeBSD debian) debian) :: OSList '['OSDebian]
+
+So, the type level OS lists are ready, on to the next step ... eventually ...
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_5_35dbd3a2eb073f4c456ac567aec569bd._comment b/doc/todo/type_level_OS_requirements/comment_5_35dbd3a2eb073f4c456ac567aec569bd._comment
new file mode 100644
index 00000000..e95a88c8
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_5_35dbd3a2eb073f4c456ac567aec569bd._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2016-03-08T21:56:26Z"
+ content="""
+I got it to throw a nice type error when intersection of two OS lists
+yields an empty list:
+
+ Couldn't match type ‘'CannotCombineOS’ with ‘'CanCombineOS’
+ Expected type: 'CanCombineOS
+ Actual type: CannotCombineOS '['OSDebian] '['OSFreeBSD] '[]
+ In the expression: intersectSupportedOS debian freeBSD
+
+I think the next step would be actually adding the OSList to Property
+and making combining properties combine their OS lists at the type level.
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_6_b10cb4445eb2519c8b3f7f080c975113._comment b/doc/todo/type_level_OS_requirements/comment_6_b10cb4445eb2519c8b3f7f080c975113._comment
new file mode 100644
index 00000000..9741de20
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_6_b10cb4445eb2519c8b3f7f080c975113._comment
@@ -0,0 +1,21 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2016-03-09T15:01:05Z"
+ content="""
+I've added a prototype of `ensureProperty` that enforces at the type level
+that the property it runs will work on an OS that's passed to it.
+
+It was easier than I thought; I didn't turn out to need reification. Just
+pass in the outer OS:
+
+ ensureProperty
+ :: (CannotCombineOS outeros inneros (IntersectOSList outeros inneros) ~ CanCombineOS)
+ => OSList outeros
+ -> Property (OSList inneros)
+ -> IO ()
+ ensureProperty outeros (Property inneros a) = a
+
+At this point, I'm confident this can be rolled out into propellor;
+there should be no big bumps in the road ahead.
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_7_6fd5354f19ec624d3eaa1c5eb427ebed._comment b/doc/todo/type_level_OS_requirements/comment_7_6fd5354f19ec624d3eaa1c5eb427ebed._comment
new file mode 100644
index 00000000..4bc3dfbb
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_7_6fd5354f19ec624d3eaa1c5eb427ebed._comment
@@ -0,0 +1,39 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2016-03-17T17:30:44Z"
+ content="""
+This looks to be adding a new type parameter:
+
+`Property NoInfo DebianOnly`
+
+So does [[type_level_resource_conflict_detection|type_level_port_conflict_detection]].
+
+Would it make sense to include both targeted OS's and used resources in the
+same list of types? Otherwise, we end up with 4 type parameters, which is
+increasingly a mouthful to write:
+
+`Property NoInfo DebianOnly '[]`
+
+Since most properties use no ports or other resources, combining the
+resources lets type alises like DebianOnly be all that needs to be
+specified:
+
+`Property NoInfo DebianOnly`
+
+When there is a resource, can use `':` to add it to the list:
+
+`Property NoInfo (Port 80 ': Port 443 ': DebianOnly)`
+
+Seems reasonable. The implementation of combining such type lists may get
+complicated, because there will be different rules for target OS's vs
+resources.
+
+----
+
+Could also move the NoInfo|HasInfo into the type list. A list without
+HasInfo would be used instead of an explicit NoInfo, so:
+
+`Property (HasInfo ': DebianOnly)`
+
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_7_a760b1a3b62f9bd8fd61eb5ec2ff216f._comment b/doc/todo/type_level_OS_requirements/comment_7_a760b1a3b62f9bd8fd61eb5ec2ff216f._comment
new file mode 100644
index 00000000..1b649fc9
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_7_a760b1a3b62f9bd8fd61eb5ec2ff216f._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="evan@0e4cded17eab71af967a38b123fbc211cf215421"
+ nickname="evan"
+ subject="Buntish Releases"
+ date="2016-03-17T03:31:57Z"
+ content="""
+I just came across another issue where the Buntish release string made a difference. I'll open a PR tomorrow sometime to show what I did (hardcoded) and maybe we can think of something cleverer using the typesystem, too.
+
+Thanks!
+"""]]
diff --git a/doc/todo/type_level_OS_requirements/comment_9_8d2153620518295f33b83f1506441fdd._comment b/doc/todo/type_level_OS_requirements/comment_9_8d2153620518295f33b83f1506441fdd._comment
new file mode 100644
index 00000000..6f4128e2
--- /dev/null
+++ b/doc/todo/type_level_OS_requirements/comment_9_8d2153620518295f33b83f1506441fdd._comment
@@ -0,0 +1,23 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 9"""
+ date="2016-03-19T18:35:20Z"
+ content="""
+I'm currently using a simple sum type to describe the target OS:
+
+ data OS = OSDebian | OSBuntish | OSFreeBSD
+
+This could in theory specify much more information about the
+OS version and architecture.
+Even type-level strings could be used to include release names.
+
+But, the old version of ghc being targeted doesn't have the nice
+Data.Type.Equality stuff; I had to implement my own clumsily
+and it would quickly hit a combinatorial explosion with more data.
+
+(There may be a better way than the way I found which works back to ghc 7.6.3.)
+
+Of course, we can always add more detail later. Since type aliases are
+used, `Propety Debian` which only specifies `OSDebian` now, could easily
+be changed at some point to specify `OSDebian AnyVersion AnyArch`.
+"""]]
diff --git a/doc/todo/type_level_port_conflict_detection.mdwn b/doc/todo/type_level_port_conflict_detection.mdwn
index 5aec5775..09d22a02 100644
--- a/doc/todo/type_level_port_conflict_detection.mdwn
+++ b/doc/todo/type_level_port_conflict_detection.mdwn
@@ -3,3 +3,87 @@ See <http://stackoverflow.com/questions/26027765/using-types-to-prevent-conflict
Needs ghc newer than 7.6.3. It may be possible to port Data.Type.Equality
and Data.Type.Bool to older versions; I got them to compile but they didn't
work right. --[[Joey]]
+
+I have a `resourceconflict` branch that adds this in Propellor.Resources,
+but it is not yet integrated into the Property types. --[[Joey]]
+
+[[!tag user/joey]]
+
+> On the `typed-os-requirements` branch, I have the UsingPort 80 singleton
+> implemented. As soon as I tried to apply it to some apache properties
+> though, I realized a problem -- If multiple apache vhosts are defined
+> each as its own property, then each of those properties can't have
+> UsingPort 80. Because the idea is to not allow combining 2 properties
+> that use the same pprt.
+>
+> Similarly, Apache.installed can't have UsingPort 80, because each of the
+> vhost properties requires that, and would inherit it.
+>
+> So, this could be used for non-vhost stuff, like simple web servers, tor
+> nodes, etc. But how to handle vhosts?
+>
+> Of course, there could be a single property that defines all of a host's
+> apache vhosts, and it could then have UsingPort 80. But that loses the
+> flexible composition of properties.
+>
+> I suppose we could include the server: `UsingPort 80 Apache`
+> (or `UsingPort 80 "apache"` to avoid needing a data type with all the
+> servers. Or even write it `"apache" '> 80`)
+> And allow combining properties that have the same server on the same
+> port. Don't allow combining `UsingPort 80 Apache` with `UsingPort 80 Ngnix`
+>
+> --[[Joey]]
+
+> > Also, it's not clear how to parameterize properties that support
+> > running a service on different ports. One way might be to
+> > declare the ports in the type signatures; the property code
+> > can then use `usedPorts (getMetaTypes self)` to get a port list.
+> >
+> > So, we'd start with a property definition that does not use any ports:
+> >
+> > virtualHost :: Domain -> WebRoot -> RevertableProperty DebianLike DebianLike
+> > virtualHost domain docroot =
+> > let self = property "vhost" (go (usedPorts (getMetaTypes self)))
+> > in self
+> > where
+> > go [] = error "No ports specified"
+> > go ports = ...
+> >
+> > And then to use it:
+> >
+> > & virtualHost "example.com" "/var/www" :: RevertableProperty (UsingPort 80 + DebianLike) DebianLike
+> >
+> > But, this seems like a mouthful to write!
+> >
+> > Maybe make a `using` that changes the metatypes of a property,
+> > adding a resource. That shortens what needs to be written some:
+> >
+> > & virtualHost "example.com" "/var/www" `using` (port :: UsingPort 80)
+> >
+> > (`port` here is just an alias for `sing`, possibly constrained to only
+> > construct port singletons.)
+> >
+> > --[[Joey]]
+> >
+> > A further problem with this is that it's not clear from the
+> > `virtualHost` type signature that it needs to have a port applied to
+> > it to get a usable property. So in a way, by adding this advanced
+> > type safety, we've lost the most fundamental type safety of all:
+> > Functions must have the right parameters applied!
+> >
+> > Well then, let's require a parameter.
+> >
+> > virtualHost :: Domain -> WebRoot -> Resource port -> RevertableProperty DebianLike DebianLike
+> >
+> > Make `Resource` only able to be constructed by `using`,
+> > so the user must say:
+> >
+> > & virtualHost "example.com" "/var/www" `using` (port :: UsingPort 80)
+> >
+> > So the type of `using` would be something like:
+> >
+> > using :: (Resource r -> Property proptype) -> r -> Property (r + proptype)
+> >
+> > (Complicated some as it needs to also support RevertableProperty.)
+> >
+> > --[[Joey]]
diff --git a/doc/todo/type_level_privdata_availability_checking.mdwn b/doc/todo/type_level_privdata_availability_checking.mdwn
new file mode 100644
index 00000000..cb0d157d
--- /dev/null
+++ b/doc/todo/type_level_privdata_availability_checking.mdwn
@@ -0,0 +1,40 @@
+When a property needs privdata to be set, it will fail at runtime when
+it's not available. Could this be detected at compile time instead?
+
+Here's an idea of a way to do it. Make propellor, whenever it adds/removes
+privdata, generate a haskell source file, Propellor/PrivData/Available.hs
+
+It would have one type-level function
+
+ data Available
+ type family HasPrivData source context
+ type instance HasPrivData "password" "foo.com" = Available
+ -- ^ supposed to be type level strings
+
+The file would be generated with
+instances of the type family for each available privdata value.
+
+`withPrivData` would use this type level function, and require it to return
+Availble. If it didn't, the type checker would blow up.
+
+(Controlling the type error message content to make it clear what went wrong
+may be tricky.)
+
+For this to work, `withPrivData` would need some interesting changes to its
+type signature, so that it has available the type level strings describing
+the privdata it's supposed to get. Is that practical? I think so,
+actually..
+
+Something like this, although my type-level comparison syntax may be off.
+
+ withPrivData :: (HasPrivData source context ~ Available) source -> context -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property i) -> Property HasInfo
+
+All that's needed to use this is a way to provide a type level string from
+which a string value can be extracted that has the same string as the type.
+IIRC, that's supported by type level strings.
+
+But.. This may get tricky/unusable when source and context are constructed
+based on data now, since the type-level source and context need to be
+constructed at build time.
+
+--[[Joey]]
diff --git a/doc/todo/typo_in_propagate.mdwn b/doc/todo/typo_in_propagate.mdwn
new file mode 100644
index 00000000..bcc74300
--- /dev/null
+++ b/doc/todo/typo_in_propagate.mdwn
@@ -0,0 +1,6 @@
+Several comments and function names use the word "propigate" which seems to be a very uncommon spelling of "propagate". For example, Webster's dictionary knows about "[propagate](http://www.merriam-webster.com/dictionary/propagate)" but not about "propigate".
+
+Thus I propose to change the spelling into "propagate". I already did the change in the last commit on the branch `typo` in the repository `https://github.com/felgru/propellor.git`, from where you can pull the change.
+
+> A typo I often make, and not intentionally as with the propell*o*r
+> spelling. [[merged|done]] --[[Joey]]
diff --git a/doc/todo/use_ghc_8.0_custom_compile_errors.mdwn b/doc/todo/use_ghc_8.0_custom_compile_errors.mdwn
new file mode 100644
index 00000000..7eed443a
--- /dev/null
+++ b/doc/todo/use_ghc_8.0_custom_compile_errors.mdwn
@@ -0,0 +1,27 @@
+<https://downloads.haskell.org/~ghc/8.0.1/docs/html/users_guide/glasgow_exts.html#custom-errors>
+
+This could be used in propellor to improve compile time errors.
+
+For example, a RevertableProperty is sometimes used where only a regular
+Property is accepted. In this case, the error could suggest that the user
+apply `setupRevertableProperty` to extract the setup side of the RevertableProperty.
+
+And, when a Property HasInfo is provided to ensureProperty, propellor could
+explain, in the compile error, why it can't let the user do that.
+
+Custom errors need a type class to be used. So, could do something like this:
+
+ class NeedsProperty a where
+ withProperty :: (Property metatype -> b) -> b
+
+ instance NeedsProperty (Property metatype) where withProperty = id
+
+ instance TypeError (Text "Use setupRevertableProperty ...")
+ => NeedsProperty RevertableProperty where
+ withProperty = error "unreachable"
+
+(While propellor needs to be buildable with older versions of ghc,
+the `instance TypeError` can just be wrapped in an ifdef to make it only be
+used by the new ghc.)
+
+[[!tag user/joey]]
diff --git a/doc/todo/use_stack_for_remote_building_propellor.mdwn b/doc/todo/use_stack_for_remote_building_propellor.mdwn
new file mode 100644
index 00000000..265596df
--- /dev/null
+++ b/doc/todo/use_stack_for_remote_building_propellor.mdwn
@@ -0,0 +1,3 @@
+Among other features [stack](https://github.com/commercialhaskell/stack/) provides a clean and deep dependency management system that even takes care of installing toolchain (ghc, alex, happy, cabal...) in a segregated environment. Building remote propellor with stack would remove the limitation that code should be compilable with stock ghc from package manager. I have done some preliminary work on this feature in my [github clone](https://github.com/abailly/propellor) for propellor, currently from 2.17.2 branch (I wanted to reuse existing properties). The code is mostly in [Bootstrap](https://github.com/abailly/propellor/blob/master/src/Propellor/Bootstrap.hs) and is currently limited to linux systems. Adapting to FreeBsd should be straightforward as this is supported by slack and there are native builds available.
+
+If there is interest in such a feature I would be happy to move it to HEAD and provide a patch.
diff --git a/doc/todo/use_stack_for_remote_building_propellor/comment_1_8a97e9ce919fa59f2e36bdd4eb3a7174._comment b/doc/todo/use_stack_for_remote_building_propellor/comment_1_8a97e9ce919fa59f2e36bdd4eb3a7174._comment
new file mode 100644
index 00000000..90dfafbc
--- /dev/null
+++ b/doc/todo/use_stack_for_remote_building_propellor/comment_1_8a97e9ce919fa59f2e36bdd4eb3a7174._comment
@@ -0,0 +1,24 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-29T18:50:07Z"
+ content="""
+`stack install propellor` is already supported, and when `propellor --init`
+detects it was installed that way, it will set up the user's propellor
+config to also be built using stack locally (via `git config
+propellor.buildsystem stack`).
+
+Supporting using stack to build propellor on the Host too is
+the missing part, and something I'd take a patch for.
+
+Your patch as it stands discards the cabal support.
+But, I personally want to continue building propellor with cabal on my
+Hosts, at least until stack is available in Debian stable, and
+probably longer. (I use Debian's ghc and haskell packages for other things
+on my hosts, so using stack would waste disk space.)
+
+I feel there needs to be a way to configure this. It would probably be fine to
+use stack on the remote host if the local propellor repository has
+`git config propellor.buildsystem stack` set. Or perhaps it should be
+configured in the config.hs.
+"""]]
diff --git a/doc/todo/use_stack_for_remote_building_propellor/comment_2_71b5434fc2347f680ea5ac75095373ea._comment b/doc/todo/use_stack_for_remote_building_propellor/comment_2_71b5434fc2347f680ea5ac75095373ea._comment
new file mode 100644
index 00000000..b3ec4968
--- /dev/null
+++ b/doc/todo/use_stack_for_remote_building_propellor/comment_2_71b5434fc2347f680ea5ac75095373ea._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 2"
+ date="2016-05-30T04:17:16Z"
+ content="""
+It would be nice to be able to build remotely with stack when one is using cabal locally, so something in config.hs would be more flexible.
+"""]]
diff --git a/doc/todo/use_stack_for_remote_building_propellor/comment_3_93cc19bf7001cf2d3960e71b60db197c._comment b/doc/todo/use_stack_for_remote_building_propellor/comment_3_93cc19bf7001cf2d3960e71b60db197c._comment
new file mode 100644
index 00000000..3d8d93a7
--- /dev/null
+++ b/doc/todo/use_stack_for_remote_building_propellor/comment_3_93cc19bf7001cf2d3960e71b60db197c._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="arnaud.oqube@c9b8c7ea33f1dea0b7a5485b86825c5bfa9efbf7"
+ nickname="arnaud.oqube"
+ subject="comment 3"
+ date="2016-05-30T07:50:28Z"
+ content="""
+OK. Indeed my patch is a bit brutal, that's one reason I have not proposed it straight away :-)
+
+I understand the rationale behind being flexible in how to build locally and remotely. Using a git config property seems pretty straightforward but I don't see how to do it within `config.hs`. Any suggestion?
+"""]]
diff --git a/doc/todo/use_stack_for_remote_building_propellor/comment_4_79074734d2837c7678de0010613700a3._comment b/doc/todo/use_stack_for_remote_building_propellor/comment_4_79074734d2837c7678de0010613700a3._comment
new file mode 100644
index 00000000..dd83ca22
--- /dev/null
+++ b/doc/todo/use_stack_for_remote_building_propellor/comment_4_79074734d2837c7678de0010613700a3._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 4"
+ date="2016-05-31T06:22:21Z"
+ content="""
+Take a look at the `precompiled` branch of Joey's repository.
+"""]]
diff --git a/doc/todo/use_stack_for_remote_building_propellor/comment_5_10e2bf7ca762b53632dd4fb86f1ce0ae._comment b/doc/todo/use_stack_for_remote_building_propellor/comment_5_10e2bf7ca762b53632dd4fb86f1ce0ae._comment
new file mode 100644
index 00000000..c39282c0
--- /dev/null
+++ b/doc/todo/use_stack_for_remote_building_propellor/comment_5_10e2bf7ca762b53632dd4fb86f1ce0ae._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2016-05-31T16:25:09Z"
+ content="""
+Following spwhitton's idea, this would involve adding a new property which
+configures the host it's attached to to build propellor using stack.
+
+This can be accomplished by having the property set some Info which can
+be looked at when propellor is deploying itself to the host,
+as shown in the precompiled branch.
+
+I guess most people who want to build
+propellor with stack would want to do that on all hosts. You could have a
+`[Host] -> [Host]` function that added the stack property to a list of
+hosts I suppose.
+"""]]
diff --git a/doc/todo/use_stack_for_remote_building_propellor/comment_6_78d9065109d6c3aa584e1755adc6c6ff._comment b/doc/todo/use_stack_for_remote_building_propellor/comment_6_78d9065109d6c3aa584e1755adc6c6ff._comment
new file mode 100644
index 00000000..d7ac262b
--- /dev/null
+++ b/doc/todo/use_stack_for_remote_building_propellor/comment_6_78d9065109d6c3aa584e1755adc6c6ff._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="arnaud.oqube@c9b8c7ea33f1dea0b7a5485b86825c5bfa9efbf7"
+ nickname="arnaud.oqube"
+ subject="comment 6"
+ date="2016-06-01T06:14:32Z"
+ content="""
+I see. Had a look at precompiled branch and this makes sense, although a little bit more involved than expected :) I will try to give it a stab in the following days.
+"""]]
diff --git a/doc/usage.mdwn b/doc/usage.mdwn
new file mode 100644
index 00000000..16e559fa
--- /dev/null
+++ b/doc/usage.mdwn
@@ -0,0 +1,147 @@
+# NAME
+
+propellor - property-based host configuration management in haskell
+
+# SYNOPSIS
+
+propellor [options]
+
+# DESCRIPTION
+
+`propellor` is a property-based host configuration management program written
+and configured in haskell.
+
+# MODES OF OPERATION
+
+* propellor
+
+ The first time you run `propellor`, without any options,
+ it will set up a `~/.propellor/` repository. Edit `~/.propellor/config.hs`
+ to configure it.
+
+ Once propellor is configured, running it without any options will take
+ action as needed to satisfy the configured properties of the local host.
+
+ If there's a central git repository, it will first fetch from the
+ repository, check the gpg signature and merge, and rebuild propellor,
+ so that any configuration changes will immediately take effect.
+
+ If propellor is run by a non-root user without any options, this is
+ the same as running propellor --spin with the hostname of the local
+ host.
+
+* propellor --spin targethost [targethost ...] [--via relayhost]
+
+ Causes propellor to automatically install itself on the specified target
+ host, or if it's already installed there, push any updates. Propellor is
+ then run on the target host, to satisfy its configured properties.
+
+ A signed git commit is made by --spin, so that any changes you have made
+ get propagated to the target host.
+
+ Multiple target hosts can be specified; propellor will run on each of
+ them in sequence.
+
+ When run with --via, propellor sshes to the relay host and runs
+ `propellor --spin hostname` from there. This can be useful when
+ propellor is installing itself, since most of the data transfer
+ is done between relay host and target host. Note that propellor
+ uses ssh agent forwarding to make this work, and the relay host
+ sees any privdata belonging to the target host.
+
+ Propellor configuration typically uses the FQDN of hosts.
+ The hostname given to --spin can be a short name, which is
+ then looked up in the DNS to find the FQDN.
+
+* propellor --add-key keyid
+
+ Adds a gpg key, which is used to encrypt the privdata.
+
+ If the gpg secret key is present, git is configured to sign commits
+ using this key. Propellor requires signed commits when pulling from
+ a central git repository.
+
+* propellor --list-fields
+
+ Lists all privdata fields that are used by your propellor configuration.
+ The first 2 columns are the field name and context, and are followed by
+ a list of the hosts that use that privdata value.
+
+* propellor --set field context
+
+ Sets a field of privdata. The content is read in from stdin.
+
+* propellor --unset field context
+
+ Removes a value from the privdata store.
+
+* propellor --unset-unused
+
+ Removes all values from the privdata store that are not currently in use.
+
+* propellor --dump field context
+
+ Outputs the privdata value to stdout.
+
+* propellor --edit field context
+
+ Opens $EDITOR on the privdata value.
+
+* propellor --merge
+
+ Combine multiple --spin commits into a single, more useful commit.
+
+ When using propellor, you may find yourself repeatedly running
+ `propellor --spin` until you get things working the way you like.
+ This results in a lot of git commits being made, with incremental
+ changes.
+
+ To clean that up to a single commit, use `propellor --merge`. A normal
+ interactive git commit will then be made, consisting of all changes
+ that have been previously committed by --spin, since the last time a
+ normal git commit was made.
+
+ (This will result in a trapezoid pattern in gitk.)
+
+* propellor --check
+
+ If propellor is able to run, this simply exits successfully.
+
+* propellor hostname
+
+ When run with a hostname and no other options, propellor will
+ provision the local host with the configuration of that hostname.
+ This is useful when the local host doesn't yet have its hostname set
+ correctly.
+
+# ENVIRONMENT
+
+Set `PROPELLOR_DEBUG=1` to make propellor output each command it runs and
+other debugging information.
+
+# GIT CONFIGURATION
+
+`git config propellor.debug 1` will configure propellor to output debugging
+information.
+
+`git config propellor.spin-branch foo` will configure propellor to refuse to
+spin when the foo branch is not checked out.
+
+`git config propellor.forbid-dirty-spin true` will configure propellor to refuse
+to spin when there are uncommitted changes in the `~/.propellor` repository.
+
+The usual git configuration controls which centralized repository (if any)
+propellor pushes and pulls from.
+
+Additionally, the url of a remote named "deploy", if it exists
+in your ~/.propellor/ repository, is used as the origin url for
+the other repositories.
+
+# SH AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+<https://propellor.branchable.com/>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.
+
diff --git a/doc/user/joey.mdwn b/doc/user/joey.mdwn
new file mode 100644
index 00000000..d4a15602
--- /dev/null
+++ b/doc/user/joey.mdwn
@@ -0,0 +1 @@
+Joey was propellor's first user.
diff --git a/doc/writing_properties.mdwn b/doc/writing_properties.mdwn
new file mode 100644
index 00000000..1b7f046a
--- /dev/null
+++ b/doc/writing_properties.mdwn
@@ -0,0 +1,81 @@
+Propellor comes with a lot of properties you can use. But eventually,
+you'll want to write a property of your own.
+
+This isn't hard. Often propellor has some properties you can use to build
+the property you want. Need to modify the content of a file? Use any of
+the properties in
+[Propellor.Property.File](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-File.htm)
+Need to run some commands? Use [Propellor.Property.Cmd](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cmd.html).
+
+To combine properties, the easiest way is to use `requires`.
+
+ someproperty `requires` otherproperty
+
+[Propellor.Property.List](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-List.html)
+has a `propertyList` combinator that's also useful.
+
+[Propellor.Property](http://hackage.haskell.org/package/propellor/docs/Propellor-Property.html)
+has some other functions to modify Properties in useful ways.
+For example, `check` makes a Property call an `IO Bool` to check if the
+Property needs be run.
+
+## example: User.hasLoginShell
+
+> As far as I can tell there is no easy way to set a user's
+> login shell. A Property User.hasLoginShell, which ensures
+> that a user has a specified login shell and that said shell
+> is in /etc/shells would be really helpful. Sadly, I lack the
+> skills to put this together myself :( -- weinzwang
+
+Propellor makes it very easy to put together a property like this.
+
+Let's start with a property that combines the two properties you mentioned:
+
+ hasLoginShell :: UserName -> FilePath -> Property UnixLike
+ hasLoginShell user shell = shellSetTo user shell `requires` shellEnabled shell
+
+The shellEnabled property can be easily written using propellor's file
+manipulation properties.
+
+ -- Need to add an import to the top of the source file.
+ import qualified Propellor.Property.File as File
+
+ shellEnabled :: FilePath -> Property UnixLike
+ shellEnabled shell = "/etc/shells" `File.containsLine` shell
+
+And then, we want to actually change the user's shell. The `chsh(1)`
+program can do that, so we can simply tell propellor the command line to
+run:
+
+ shellSetTo :: UserName -> FilePath -> Property UnixLike
+ shellSetTo user shell = cmdProperty "chsh" ["--shell", shell, user]
+
+The only remaining problem with this is that shellSetTo runs chsh every
+time, and propellor will always display that it's made a change each time
+it runs, even when it didn't really do much. Now, there's an easy way to
+avoid that problem, we could just tell propellor to assume that chsh
+has not made a change:
+
+ shellSetTo :: UserName -> FilePath -> Property UnixLike
+ shellSetTo user shell = cmdProperty "chsh" ["--shell", shell, user]
+ `assume` NoChange
+
+But, it's not much harder to do this right. Let's make the property
+check if the user's shell is already set to the desired value and avoid
+doing anything in that case.
+
+ shellSetTo :: UserName -> FilePath -> Property UnixLike
+ shellSetTo user shell = check needchangeshell $
+ cmdProperty "chsh" ["--shell", shell, user]
+ where
+ needchangeshell = do
+ currshell <- userShell <$> getUserEntryForName user
+ return (currshell /= shell)
+
+And that will probably all work, although I've not tested it. You might
+want to throw in some uses of `describe` to give the new properties
+more useful descriptions.
+
+I hope this has been helpful as an explanation of how to add properties to
+Propellor, and if you get these properties to work, a patch adding them
+to Propellor.User would be happily merged.
diff --git a/joeyconfig.hs b/joeyconfig.hs
new file mode 100644
index 00000000..98c565c5
--- /dev/null
+++ b/joeyconfig.hs
@@ -0,0 +1,636 @@
+-- This is the live config file used by propellor's author.
+-- https://propellor.branchable.com/
+module Main where
+
+import Propellor
+import Propellor.Property.Scheduled
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Network as Network
+import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.Ssh as Ssh
+import qualified Propellor.Property.Cron as Cron
+import qualified Propellor.Property.Sudo as Sudo
+import qualified Propellor.Property.User as User
+import qualified Propellor.Property.Hostname as Hostname
+import qualified Propellor.Property.Tor as Tor
+import qualified Propellor.Property.Dns as Dns
+import qualified Propellor.Property.OpenId as OpenId
+import qualified Propellor.Property.Git as Git
+import qualified Propellor.Property.Postfix as Postfix
+import qualified Propellor.Property.Apache as Apache
+import qualified Propellor.Property.LetsEncrypt as LetsEncrypt
+import qualified Propellor.Property.Grub as Grub
+import qualified Propellor.Property.Obnam as Obnam
+import qualified Propellor.Property.Gpg as Gpg
+import qualified Propellor.Property.Systemd as Systemd
+import qualified Propellor.Property.Journald as Journald
+import qualified Propellor.Property.Chroot as Chroot
+import qualified Propellor.Property.Fail2Ban as Fail2Ban
+import qualified Propellor.Property.Aiccu as Aiccu
+import qualified Propellor.Property.OS as OS
+import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost
+import qualified Propellor.Property.HostingProvider.Linode as Linode
+import qualified Propellor.Property.SiteSpecific.GitHome as GitHome
+import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
+import qualified Propellor.Property.SiteSpecific.IABak as IABak
+import qualified Propellor.Property.SiteSpecific.Branchable as Branchable
+import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
+import Propellor.Property.DiskImage
+
+main :: IO () -- _ ______`| ,-.__
+main = defaultMain hosts -- / \___-=O`/|O`/__| (____.'
+ {- Propellor -- \ / | / ) _.-"-._
+ Deployed -} -- `/-==__ _/__|/__=-| ( \_
+hosts :: [Host] -- * \ | | '--------'
+hosts = -- (o) `
+ [ darkstar
+ , gnu
+ , clam
+ , mayfly
+ , oyster
+ , orca
+ , honeybee
+ , kite
+ , elephant
+ , beaver
+ , pell
+ , iabak
+ ] ++ monsters
+
+testvm :: Host
+testvm = host "testvm.kitenet.net" $ props
+ & osDebian Unstable "amd64"
+ & OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net")
+ `onChange` postinstall
+ & Hostname.sane
+ & Hostname.searchDomain
+ & Apt.installed ["linux-image-amd64"]
+ & Apt.installed ["ssh"]
+ & User.hasPassword (User "root")
+ where
+ postinstall :: Property DebianLike
+ postinstall = propertyList "fixing up after clean install" $ props
+ & OS.preserveRootSshAuthorized
+ & OS.preserveResolvConf
+ & Apt.update
+ & Grub.boots "/dev/sda"
+ `requires` Grub.installed Grub.PC
+
+darkstar :: Host
+darkstar = host "darkstar.kitenet.net" $ props
+ & ipv6 "2001:4830:1600:187::2"
+ & Aiccu.hasConfig "T18376" "JHZ2-SIXXS"
+
+ & Apt.buildDep ["git-annex"] `period` Daily
+
+ & JoeySites.postfixClientRelay (Context "darkstar.kitenet.net")
+ & JoeySites.dkimMilter
+ & JoeySites.alarmClock "*-*-* 7:30" (User "joey")
+ "/usr/bin/timeout 45m /home/joey/bin/goodmorning"
+
+ ! imageBuilt "/tmp/img" c MSDOS (grubBooted PC)
+ [ partition EXT2 `mountedAt` "/boot"
+ `setFlag` BootFlag
+ , partition EXT4 `mountedAt` "/"
+ `mountOpt` errorReadonly
+ , swapPartition (MegaBytes 256)
+ ]
+ where
+ c d = Chroot.debootstrapped mempty d $ props
+ & osDebian Unstable "amd64"
+ & Hostname.setTo "demo"
+ & Apt.installed ["linux-image-amd64"]
+ & User "root" `User.hasInsecurePassword` "root"
+
+gnu :: Host
+gnu = host "gnu.kitenet.net" $ props
+ & Apt.buildDep ["git-annex"] `period` Daily
+
+ & JoeySites.postfixClientRelay (Context "gnu.kitenet.net")
+ & JoeySites.dkimMilter
+
+clam :: Host
+clam = host "clam.kitenet.net" $ props
+ & standardSystem Unstable "amd64"
+ ["Unreliable server. Anything here may be lost at any time!" ]
+ & ipv4 "167.88.41.194"
+
+ & CloudAtCost.decruft
+ & Ssh.hostKeys hostContext
+ [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAI3WUq0RaigLlcUivgNG4sXpso2ORZkMvfqKz6zkc60L6dpxvWDNmZVEH8hEjxRSYG07NehcuOgQqeyFnS++xw1hdeGjf37JqCUH49i02lra3Zxv8oPpRxyeqe5MmuzUJhlWvBdlc3O/nqZ4bTUfnxMzSYWyy6++s/BpSHttZplNAAAAFQC1DE0vzgVeNAv9smHLObQWZFe2VQAAAIBECtpJry3GC8NVTFsTHDGWksluoFPIbKiZUFFztZGdM0AO2VwAbiJ6Au6M3VddGFANgTlni6d2/9yS919zO90TaFoIjywZeXhxE2CSuRfU7sx2hqDBk73jlycem/ER0sanFhzpHVpwmLfWneTXImWyq37vhAxatJANOtbj81vQ3AAAAIBV3lcyTT9xWg1Q4vERJbvyF8mCliwZmnIPa7ohveKkxlcgUk5d6dnaqFfjVaiXBPN3Qd08WXoQ/a9k3chBPT9nW2vWgzzM8l36j2MbHLmaxGwevAc9+vx4MXqvnGHzd2ex950mC33ct3j0fzMZlO6vqEsgD4CYmiASxhfefj+JCQ==")
+ , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDJybAjUPUWIhvVMmer8K5ZgdfI54DM6vc8Mzw+5KmVKL0TwkvzbR1HAB4heyMGtN1F8YzkWhsI3/Txh+MQUJ+i4u8SvSYc6D1q3j3ZyCi06wZ3DJS25tZrOM/thOOA1DFA4Hhb0uI/1Kg8PguNNNSMXn8F7q3F6cFQizYgszs6z6ktiST/BTC+IXWovhcnn2vQXXU8FTcTsqBFqA5dEjZbp1WDzqp3km84ZyXGmoVlpqzXeMvlkWTIshYiQjXIwPOkALzlGYjp1lw1OaxPVI1IGFcgCbIWQQWoCReb+genX2VaR+odAYXjaOdRx0lQj7UCPTBCpqMyzBMLtT5Yiaqh")
+ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPhfvcOuw0Yt+MnsFc4TI2gWkKi62Eajxz+TgbHMO/uRTYF8c5V8fOI3o+J/3m5+lT0S5o8j8a7xIC3COvi+AVw=")
+ ]
+ & Apt.unattendedUpgrades
+ & Network.ipv6to4
+ & Systemd.persistentJournal
+ & Journald.systemMaxUse "500MiB"
+
+ & Tor.isRelay
+ & Tor.named "kite1"
+ & Tor.bandwidthRate (Tor.PerMonth "400 GB")
+
+ & Systemd.nspawned webserver
+ & File.dirExists "/var/www/html"
+ & File.notPresent "/var/www/index.html"
+ & "/var/www/html/index.html" `File.hasContent` ["hello, world"]
+ & alias "helloworld.kitenet.net"
+
+ & Systemd.nspawned oldusenetShellBox
+
+ & JoeySites.scrollBox
+ & alias "scroll.joeyh.name"
+ & alias "us.scroll.joeyh.name"
+
+mayfly :: Host
+mayfly = host "mayfly.kitenet.net" $ props
+ & standardSystem (Stable "jessie") "amd64"
+ [ "Scratch VM. Contents can change at any time!" ]
+ & ipv4 "167.88.36.193"
+
+ & CloudAtCost.decruft
+ & Apt.unattendedUpgrades
+ & Network.ipv6to4
+ & Systemd.persistentJournal
+ & Journald.systemMaxUse "500MiB"
+
+ & Tor.isRelay
+ & Tor.named "kite3"
+ & Tor.bandwidthRate (Tor.PerMonth "400 GB")
+
+oyster :: Host
+oyster = host "oyster.kitenet.net" $ props
+ & standardSystem Unstable "amd64"
+ [ "Unreliable server. Anything here may be lost at any time!" ]
+ & ipv4 "104.167.117.109"
+
+ & CloudAtCost.decruft
+ & Ssh.hostKeys hostContext
+ [ (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBP0ws/IxQegVU0RhqnIm5A/vRSPTO70wD4o2Bd1jL970dTetNyXzvWGe1spEbLjIYSLIO7WvOBSE5RhplBKFMUU=")
+ ]
+ & Apt.unattendedUpgrades
+ & Network.ipv6to4
+ & Systemd.persistentJournal
+ & Journald.systemMaxUse "500MiB"
+
+ & Tor.isRelay
+ & Tor.named "kite2"
+ & Tor.bandwidthRate (Tor.PerMonth "400 GB")
+
+ -- Nothing is using http port 80, so listen on
+ -- that port for ssh, for traveling on bad networks that
+ -- block 22.
+ & Ssh.listenPort (Port 80)
+
+orca :: Host
+orca = host "orca.kitenet.net" $ props
+ & standardSystem Unstable "amd64" [ "Main git-annex build box." ]
+ & ipv4 "138.38.108.179"
+
+ & Apt.unattendedUpgrades
+ & Postfix.satellite
+ & Apt.serviceInstalledRunning "ntp"
+ & Systemd.persistentJournal
+
+ & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
+ GitAnnexBuilder.standardAutoBuilder
+ Unstable "amd64" Nothing (Cron.Times "15 * * * *") "2h")
+ & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
+ GitAnnexBuilder.standardAutoBuilder
+ Unstable "i386" Nothing (Cron.Times "30 * * * *") "2h")
+ & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
+ GitAnnexBuilder.stackAutoBuilder
+ (Stable "jessie") "i386" (Just "ancient") (Cron.Times "45 * * * *") "2h")
+ & Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer
+ (Cron.Times "1 1 * * *") "3h")
+
+honeybee :: Host
+honeybee = host "honeybee.kitenet.net" $ props
+ & standardSystem Testing "armhf" [ "Arm git-annex build box." ]
+
+ -- I have to travel to get console access, so no automatic
+ -- upgrades, and try to be robust.
+ & "/etc/default/rcS" `File.containsLine` "FSCKFIX=yes"
+
+ & Apt.installed ["flash-kernel"]
+ & "/etc/flash-kernel/machine" `File.hasContent` ["Cubietech Cubietruck"]
+ & Apt.installed ["linux-image-armmp"]
+ & Network.dhcp "eth0" `requires` Network.cleanInterfacesFile
+ & Postfix.satellite
+
+ -- ipv6 used for remote access thru firewalls
+ & Apt.serviceInstalledRunning "aiccu"
+ & ipv6 "2001:4830:1600:187::2"
+ -- restart to deal with failure to connect, tunnel issues, etc
+ & Cron.job "aiccu restart daily" Cron.Daily (User "root") "/"
+ "service aiccu stop; service aiccu start"
+
+ -- In case compiler needs more than available ram
+ & Apt.serviceInstalledRunning "swapspace"
+
+ -- No hardware clock.
+ & Apt.serviceInstalledRunning "ntp"
+
+ & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
+ GitAnnexBuilder.armAutoBuilder
+ Unstable "armel" Nothing Cron.Daily "22h")
+
+-- This is not a complete description of kite, since it's a
+-- multiuser system with eg, user passwords that are not deployed
+-- with propellor.
+kite :: Host
+kite = host "kite.kitenet.net" $ props
+ & standardSystemUnhardened Testing "amd64" [ "Welcome to kite!" ]
+ & ipv4 "66.228.36.95"
+ & ipv6 "2600:3c03::f03c:91ff:fe73:b0d2"
+ & alias "kitenet.net"
+ & alias "wren.kitenet.net" -- temporary
+ & Ssh.hostKeys (Context "kitenet.net")
+ [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAO9tnPUT4p+9z7K6/OYuiBNHaij4Nzv5YVBih1vMl+ALz0gYAj8RWJzXmqp5buFAyfgOoLw+H9s1bBS01Sy3i07Dm6cx1fWG4RXL/E/3w1tavX99GD2bBxDBu890ebA5Tp+eFRJkS9+JwSvFiF6CP7NbVjifCagoUO56Ig048RwDAAAAFQDPY2xM3q6KwsVQliel23nrd0rV2QAAAIEAga3hj1hL00rYPNnAUzT8GAaSP62S4W68lusErH+KPbsMwFBFY/Ib1FVf8k6Zn6dZLh/HH/RtJi0JwdzPI1IFW+lwVbKfwBvhQ1lw9cH2rs1UIVgi7Wxdgfy8gEWxf+QIqn62wG+Ulf/HkWGvTrRpoJqlYRNS/gnOWj9Z/4s99koAAACBAM/uJIo2I0nK15wXiTYs/NYUZA7wcErugFn70TRbSgduIFH6U/CQa3rgHJw9DCPCQJLq7pwCnFH7too/qaK+czDk04PsgqV0+Jc7957gU5miPg50d60eJMctHV4eQ1FpwmGGfXxRBR9k2ZvikWYatYir3L6/x1ir7M0bA9IzNU45")
+ , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAIEA2QAJEuvbTmaN9ex9i9bjPhMGj+PHUYq2keIiaIImJ+8mo+yKSaGUxebG4tpuDPx6KZjdycyJt74IXfn1voGUrfzwaEY9NkqOP3v6OWTC3QeUGqDCeJ2ipslbEd9Ep9XBp+/ldDQm60D0XsIZdmDeN6MrHSbKF4fXv1bqpUoUILk=")
+ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBLF+dzqBJZix+CWUkAd3Bd3cofFCKwHMNRIfwx1G7dL4XFe6fMKxmrNetQcodo2edyufwoPmCPr3NmnwON9vyh0=")
+ , (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFZftKMnH/zH29BHMKbcBO4QsgTrstYFVhbrzrlRzBO3")
+ ]
+
+ & Network.static "eth0" `requires` Network.cleanInterfacesFile
+ & Apt.installed ["linux-image-amd64"]
+ & Linode.chainPVGrub 5
+ & Linode.mlocateEnabled
+ & Apt.unattendedUpgrades
+ & Systemd.installed
+ & Systemd.persistentJournal
+ & Journald.systemMaxUse "500MiB"
+ & Ssh.passwordAuthentication True
+ -- Since ssh password authentication is allowed:
+ & Fail2Ban.installed
+ & Apt.serviceInstalledRunning "ntp"
+ & "/etc/timezone" `File.hasContent` ["US/Eastern"]
+
+ & Obnam.backupEncrypted "/" (Cron.Times "33 1 * * *")
+ [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-root.obnam"
+ , "--client-name=kitenet.net"
+ , "--exclude=/home"
+ , "--exclude=/var/cache"
+ , "--exclude=/var/tmp"
+ , "--exclude=/srv/git"
+ , "--exclude=/var/spool/oldusenet"
+ , "--exclude=.*/tmp/"
+ , "--one-file-system"
+ , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]
+ ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")
+ `requires` rootsshkey
+ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
+ & Obnam.backupEncrypted "/home" (Cron.Times "33 3 * * *")
+ [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-home.obnam"
+ , "--client-name=kitenet.net"
+ , "--exclude=/home/joey/lib"
+ , "--one-file-system"
+ , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]
+ ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")
+ `requires` rootsshkey
+ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
+
+ & alias "smtp.kitenet.net"
+ & alias "imap.kitenet.net"
+ & alias "pop.kitenet.net"
+ & alias "mail.kitenet.net"
+ & JoeySites.kiteMailServer
+
+ & JoeySites.legacyWebSites
+ & File.ownerGroup "/srv/web" (User "joey") (Group "joey")
+ & Apt.installed ["analog"]
+
+ & alias "git.kitenet.net"
+ & alias "git.joeyh.name"
+ & JoeySites.gitServer hosts
+
+ & JoeySites.downloads hosts
+ & JoeySites.gitAnnexDistributor
+ & JoeySites.tmp
+
+ & alias "bitlbee.kitenet.net"
+ & Apt.serviceInstalledRunning "bitlbee"
+ & "/etc/bitlbee/bitlbee.conf" `File.hasContent`
+ [ "[settings]"
+ , "User = bitlbee"
+ , "AuthMode = Registered"
+ , "[defaults]"
+ ]
+ `onChange` Service.restarted "bitlbee"
+ & "/etc/default/bitlbee" `File.containsLine` "BITLBEE_PORT=\"6767\""
+ `onChange` Service.restarted "bitlbee"
+
+ & Apt.installed
+ [ "git-annex", "myrepos"
+ , "build-essential", "make"
+ , "rss2email", "archivemail"
+ , "devscripts"
+ -- Some users have zsh as their login shell.
+ , "zsh"
+ ]
+
+ & alias "nntp.olduse.net"
+ & JoeySites.oldUseNetServer hosts
+
+ & alias "ns4.kitenet.net"
+ & myDnsPrimary True "kitenet.net" []
+ & myDnsPrimary True "joeyh.name" []
+ & myDnsPrimary True "ikiwiki.info" []
+ & myDnsPrimary True "olduse.net"
+ [ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk")
+ ]
+ & alias "ns4.branchable.com"
+ & branchableSecondary
+ & Dns.secondaryFor ["animx"] hosts "animx.eu.org"
+
+ -- testing
+ & Apache.httpsVirtualHost "letsencrypt.joeyh.name" "/var/www/html"
+ (LetsEncrypt.AgreeTOS (Just "id@joeyh.name"))
+ & alias "letsencrypt.joeyh.name"
+ where
+ rootsshkey = Ssh.userKeys (User "root")
+ (Context "kite.kitenet.net")
+ [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite")
+ ]
+
+elephant :: Host
+elephant = host "elephant.kitenet.net" $ props
+ & standardSystem Unstable "amd64"
+ [ "Storage, big data, and backups, omnomnom!"
+ , "(Encrypt all data stored here.)"
+ ]
+ & ipv4 "193.234.225.114"
+ & Ssh.hostKeys hostContext
+ [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBANxXGWac0Yz58akI3UbLkphAa8VPDCGswTS0CT3D5xWyL9OeArISAi/OKRIvxA4c+9XnWtNXS7nYVFDJmzzg8v3ZMx543AxXK82kXCfvTOc/nAlVz9YKJAA+FmCloxpmOGrdiTx1k36FE+uQgorslGW/QTxnOcO03fDZej/ppJifAAAAFQCnenyJIw6iJB1+zuF/1TSLT8UAeQAAAIEA1WDrI8rKnxnh2rGaQ0nk+lOcVMLEr7AxParnZjgC4wt2mm/BmkF/feI1Fjft2z4D+V1W7MJHOqshliuproxhFUNGgX9fTbstFJf66p7h7OLAlwK8ZkpRk/uV3h5cIUPel6aCwjL5M2gN6/yq+gcCTXeHLq9OPyUTmlN77SBL71UAAACBAJJiCHWxPAGooe7Vv3W7EIBbsDyf7b2kDH3bsIlo+XFcKIN6jysBu4kn9utjFlrlPeHUDzGQHe+DmSqTUQQ0JPCRGcAcuJL8XUqhJi6A6ye51M9hVt51cJMXmERx9TjLOP/adkEuxpv3Fj20FxRUr1HOmvRvewSHrJ1GeA1bjbYL")
+ , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCrEQ7aNmRYyLKY7xHILQsyV/w0B3++D98vn5IvjHkDnitrUWjB+vPxlS7LYKLzN9Jx7Hb14R2lg7+wdgtFMxLZZukA8b0tqFpTdRFBvBYGh8IM8Id1iE/6io/NZl+hTQEDp0LJP+RljH1CLfz7J3qtc+v6NbfTP5cOgH104mWYoLWzJGaZ4p53jz6THRWnVXy5nPO3dSBr2f/SQgRuJQWHNIh0jicRGD8H2kzOQzilpo+Y46PWtkufl3Yu3UsP5UMAyLRIXwZ6nNRZqRiVWrX44hoNfDbooTdFobbHlqMl+y6291bOXaOA6PACk8B4IVcC89/gmc9Oe4EaDuszU5kD")
+ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAJkoPRhUGT8EId6m37uBdYEtq42VNwslKnc9mmO+89ody066q6seHKeFY6ImfwjcyIjM30RTzEwftuVNQnbEB0=")
+ , (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB6VtXi0uygxZeCo26n6PuCTlSFCBcwRifv6N8HdWh2Z")
+ ]
+
+ & Grub.chainPVGrub "hd0,0" "xen/xvda1" 30
+ & Postfix.satellite
+ & Apt.unattendedUpgrades
+ & Systemd.installed
+ & Systemd.persistentJournal
+ & Ssh.userKeys (User "joey") hostContext
+ [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC4wJuQEGno+nJvtE75IKL6JQ08sJHZ9Bzs9Dvu0zuxSEZE30MWK98/twNwCH9PVf2N9m4apfN7f9GHgHTUongfo8xnLAk4PuBSTV74YgKyOCvNYqANuKKa+76PsS/vFf/or3ct++uTEWsRyYD29cQndufwKA4rthAqHG+fifbLDC53AjcldI0zI1RckpPzT+AMazlnSBFMlpKvGD2uzSXALVRXa3vSqWkWd0z7qmIkpmpq0AAgbDLwrGBcUGV/h0rOa2s8zSeirA0tLmHNROl4cZsX0T/6VBGfBRkrHSxL67xJziATw4WPq6spYlxg84pC/5qJVr9SC5HosppbDqgj joey@elephant")
+ ]
+ & Apt.serviceInstalledRunning "swapspace"
+
+ & alias "eubackup.kitenet.net"
+ & Apt.installed ["obnam", "sshfs", "rsync"]
+ & JoeySites.obnamRepos ["pell", "kite"]
+ & JoeySites.githubBackup
+ & JoeySites.rsyncNetBackup hosts
+
+ & alias "podcatcher.kitenet.net"
+ & JoeySites.podcatcher
+
+ & alias "znc.kitenet.net"
+ & JoeySites.ircBouncer
+ & alias "kgb.kitenet.net"
+ & JoeySites.kgbServer
+
+ & alias "mumble.kitenet.net"
+ & JoeySites.mumbleServer hosts
+
+ & alias "ns3.kitenet.net"
+ & myDnsSecondary
+
+ & Systemd.nspawned oldusenetShellBox
+ & Systemd.nspawned ancientKitenet
+ & Systemd.nspawned openidProvider
+ `requires` Apt.serviceInstalledRunning "ntp"
+
+ & JoeySites.scrollBox
+ & alias "scroll.joeyh.name"
+ & alias "eu.scroll.joeyh.name"
+
+ -- For https port 443, shellinabox with ssh login to
+ -- kitenet.net
+ & alias "shell.kitenet.net"
+ & Systemd.nspawned kiteShellBox
+ -- Nothing is using http port 80, so listen on
+ -- that port for ssh, for traveling on bad networks that
+ -- block 22.
+ & Ssh.listenPort (Port 80)
+
+beaver :: Host
+beaver = host "beaver.kitenet.net" $ props
+ & ipv6 "2001:4830:1600:195::2"
+ & Apt.serviceInstalledRunning "aiccu"
+ & Apt.installed ["ssh"]
+ & Ssh.hostPubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAACBAIrLX260fY0Jjj/p0syNhX8OyR8hcr6feDPGOj87bMad0k/w/taDSOzpXe0Wet7rvUTbxUjH+Q5wPd4R9zkaSDiR/tCb45OdG6JsaIkmqncwe8yrU+pqSRCxttwbcFe+UU+4AAcinjVedZjVRDj2rRaFPc9BXkPt7ffk8GwEJ31/AAAAFQCG/gOjObsr86vvldUZHCteaJttNQAAAIB5nomvcqOk/TD07DLaWKyG7gAcW5WnfY3WtnvLRAFk09aq1EuiJ6Yba99Zkb+bsxXv89FWjWDg/Z3Psa22JMyi0HEDVsOevy/1sEQ96AGH5ijLzFInfXAM7gaJKXASD7hPbVdjySbgRCdwu0dzmQWHtH+8i1CMVmA2/a5Y/wtlJAAAAIAUZj2US2D378jBwyX1Py7e4sJfea3WSGYZjn4DLlsLGsB88POuh32aOChd1yzF6r6C2sdoPBHQcWBgNGXcx4gF0B5UmyVHg3lIX2NVSG1ZmfuLNJs9iKNu4cHXUmqBbwFYQJBvB69EEtrOw4jSbiTKwHFmqdA/mw1VsMB+khUaVw=="
+ & alias "usbackup.kitenet.net"
+ & JoeySites.backupsBackedupFrom hosts "eubackup.kitenet.net" "/home/joey/lib/backup"
+ & Apt.serviceInstalledRunning "anacron"
+ & Cron.niceJob "system disk backed up" Cron.Weekly (User "root") "/"
+ "rsync -a -x / /home/joey/lib/backup/beaver.kitenet.net/"
+
+-- Branchable is not completely deployed with propellor yet.
+pell :: Host
+pell = host "pell.branchable.com" $ props
+ & alias "branchable.com"
+ & ipv4 "66.228.46.55"
+ & ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
+
+ -- All the websites I host at branchable that don't use
+ -- branchable.com dns.
+ & alias "olduse.net"
+ & alias "www.olduse.net"
+ & alias "www.kitenet.net"
+ & alias "joeyh.name"
+ & alias "campaign.joeyh.name"
+ & alias "ikiwiki.info"
+ & alias "git.ikiwiki.info"
+ & alias "l10n.ikiwiki.info"
+ & alias "dist-bugs.kitenet.net"
+ & alias "family.kitenet.net"
+
+ & Apt.installed ["linux-image-amd64"]
+ & Linode.chainPVGrub 5
+ & Apt.unattendedUpgrades
+ & Branchable.server hosts
+
+iabak :: Host
+iabak = host "iabak.archiveteam.org" $ props
+ & ipv4 "124.6.40.227"
+ & Hostname.sane
+ & osDebian Testing "amd64"
+ & Systemd.persistentJournal
+ & Cron.runPropellor (Cron.Times "30 * * * *")
+ & Apt.stdSourcesList `onChange` Apt.upgrade
+ & Apt.installed ["git", "ssh"]
+ & Ssh.hostKeys (Context "iabak.archiveteam.org")
+ [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAMhuYTshLxavWCpfyJxg3j/GWyIRlL3VTharsfUTzMOqyMSWantZjflfJX21z2KzFDtPEA711GYztsgMVXMrsPQInaOKNISe/R9cfgnEktKTxeppWTfw0GTNcpCeeecddU0FCPVW3a6yDoT6+Rv0jPvkQoDGmhQ40MhauMrO0mJ9AAAAFQDpCbXG8o/3Sg7wrsp5abizJoQ0yQAAAIEAxxyHo/ZhDPP+EWtDS05s5dwiDMUsxIllk1NeleAOQIyLtFkaifOeskDJybIPWYPGX1trjcPoGuXJ5GBYrRaPiu6FBvYdYMFRLr4uNBsaSHHqlHhBPkP3RzCrdUyau4XyjdE4iA0EQlO+u11A+o3f7aTuJSveM0YRfbqvaatG89EAAACAWd0h0SkRLnGjBzkou0SQfYujFY9ilhWXPWV/oOs+bieDSpvfmnaEfLSinVFRrJPvQp/dtpxPLEm+StrK3w6dmwTZVUM5JEoB1mRjBkVs6gPC9PVVg9qLpzC2/x+r5cTfrffjyRrlPdkwLKpO6oiPxTIxAyCW8ixjafkxe2hAeJo=")
+ , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDP13oPRLRY0V9ZDWojb8TgHbUdE30Nq3b541TwPmlLMbYPAhldxGHkuXGlX8g9/FYP/1AgkPcxs2Uc61ZV+1Ss7q7t52f4R0bO4WHqxfdXHd9FlLzMLWxMU3aMr693pGlhnUp3/xH6O6/+bNEIo3VGGgv9XDr2cAxypS9J7X9ibHZcZ3BGvoCR+nnFJ00ERG2tREKZBPDWKk76lhCiM21fG/CSmcApXaA45FHDaM9/2Clj1sXvoS72f0hEKpl1m08sUx+F0GPzQESnKqNFl+xXdYPPbfhdrgCnDmx9tL5NnXsJU2beFiuxpICOeB1HV6DJsdlO18WqwXYhOg/2A1H3")
+ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBHb0kXcrF5ThwS8wB0Hez404Zp9bz78ZxEGSqnwuF4d/N3+bymg7/HAj7l/SzRoEXKHsJ7P5320oMxBHeM16Y+k=")
+ ]
+ & Apt.installed ["etckeeper", "sudo"]
+ & Apt.installed ["vim", "screen", "tmux", "less", "emax-nox", "netcat"]
+ & User.hasSomePassword (User "root")
+ & propertyList "admin accounts"
+ (toProps $ map User.accountFor admins ++ map Sudo.enabledFor admins)
+ & User.hasSomePassword (User "joey")
+ & GitHome.installedFor (User "joey")
+ & Ssh.authorizedKey (User "db48x") "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAAIAQDQ6urXcMDeyuFf4Ga7CuGezTShKnEMPHKJm7RQUtw3yXCPX5wnbvPS2+UFnHMzJvWOX5S5b/XpBpOusP0jLpxwOCEg4nA5b7uvWJ2VIChlMqopYMo+tDOYzK/Q74MZiNWi2hvf1tn3N9SnqOa7muBMKMENIX5KJdH8cJ/BaPqAP883gF8r2SwSZFvaB0xYCT/CIylC593n/+0+Lm07NUJIO8jil3n2SwXdVg6ib65FxZoO86M46wTghnB29GXqrzraOg+5DY1zzCWpIUtFwGr4DP0HqLVtmAkC7NI14l1M0oHE0UEbhoLx/a+mOIMD2DuzW3Rs3ZmHtGLj4PL/eBU8D33AqSeM0uR/0pEcoq6A3a8ixibj9MBYD2lMh+Doa2audxS1OLM//FeNccbm1zlvvde82PZtiO11P98uN+ja4A+CfgQU5s0z0wikc4gXNhWpgvz8DrOEJrjstwOoqkLg2PpIdHRw7dhpp3K1Pc+CGAptDwbKkxs4rzUgMbO9DKI7fPcXXgKHLLShMpmSA2vsQUMfuCp2cVrQJ+Vkbwo29N0Js5yU7L4NL4H854Nbk5uwWJCs/mjXtvTimN2va23HEecTpk44HDUjJ9NyevAfPcO9q1ZtgXFTQSMcdv1m10Fvmnaiy8biHnopL6MBo1VRITh5UFiJYfK4kpTTg2vSspii/FYkkYOAnnZtXZqMehP7OZjJ6HWJpsCVR2hxP3sKOoQu+kcADWa/4obdp+z7gY8iMMjd6kwuIWsNV8KsX+eVJ4UFpAi/L00ZjI2B9QLVCsOg6D1fT0698wEchwUROy5vZZJq0078BdAGnwC0WGLt+7OUgn3O2gUAkb9ffD0odbZSqq96NCelM6RaHA+AaIE4tjGL3lFkyOtb+IGPNACQ73/lmaRQd6Cgasq9cEo0g22Ew5NQi0CBuu1aLDk7ezu3SbU09eB9lcZ+8lFnl5K2eQFeVJStFJbJNfOvgKyOb7ePsrUFF5GJ2J/o1F60fRnG64HizZHxyFWkEOh+k3i8qO+whPa5MTQeYLYb6ysaTPrUwNRcSNNCcPEN8uYOh1dOFAtIYDcYA56BZ321yz0b5umj+pLsrFU+4wMjWxZi0inJzDS4dVegBVcRm0NP5u8VRosJQE9xdbt5K1I0khzhrEW1kowoTbhsZCaDHhL9LZo73Z1WIHvulvlF3RLZip5hhtQu3ZVkbdV5uts8AWaEWVnIu9z0GtQeeOuseZpT0u1/1xjVAOKIzuY3sB7FKOaipe8TDvmdiQf/ICySqqYaYhN6GOhiYccSleoX6yzhYuCvzTgAyWHIfW0t25ff1CM7Vn+Vo9cVplIer1pbwhZZy4QkROWTOE+3yuRlQ+o6op4hTGdAZhjKh9zkDW7rzqQECFrZrX/9mJhxYKjhpkk0X3dSipPt9SUHagc4igya+NgCygQkWBOQfr4uia0LcwDxy4Kchw7ZuypHuGVZkGhNHXS+9JdAHopnSqYwDMG/z1ys1vQihgER0b9g3TchvGF+nmHe2kbM1iuIYMNNlaZD1yGZ5qR7wr/8dw8r0NBEwzsUfak3BUPX7H6X0tGS96llwUxmvQD85WNNoef0uryuAtDEwWlfN1RmWysZDc57Rn4gZi0M5jXmQD23ZiYXYBcG849OeqNzlxONEFsForXO/29Ud4x/Hqa9tf+kJbqMRsaLFO+PXhHzgl6ZHLAljQDxrJ6keNnkqaYfqQ8wyRi1mKv4Ab57kde7mUsZhe7w93GaE9Lxfvu7d3pB+lXfI9NJCSITHreUP4JfmFW+p/eVg+r/1wbElNylGna4I4+qYObOUncGwFKYdFPdtU1XLDKXmywTEgbEh7iI9zX0xD3bPHQLMg+TTtXiU9dQm1x/0zRf9trwDsRDJCbG4/P4iQYkcVvYx2CCfi0JSHv8tWsLi3GJKJLXUxZyzfvY2lThPeYnnY/HFrPJCyJUN55QuRmfzbu8rHgWlcyOlVpKtz+7kn823kEQykiIYKIKrb0G6VBzuMtAk9XzJPv+Wu7suOGXHlVfCqPLk6RjHDm4kTYciW9VgxDts5Y+zwcAbrUeA4UuN/6KisWpivMrfDSIHUCeH/lHBtNkqKohdrUKJMEOx5X6r2dJbmoTFBDi5XtYu/5cBtiDMmupNB0S+pZ2JD5/RKtj6kgzTeE1q/OG4q/eq1O1rjf0vIS31luy27K/YHFIGE0D/CmuXE74Uyaxm27RnrKUxEBl84V70GaIF4F5On8pSThxxizigXTRTKiczc+A5Zi29mid+1EFeUAJOa/DuHJfpVNY4pYEmhPl/Bk66L8kzlbJz6Hg/LIiJIRcy3UKrbSxPFIDpXn33drBHgklMDlrIVDZDXF6cn0Ml71SabB4A3TM6TK+oWZoyvftPIhcWhVwAWQj7nFNAiMEl1z/29ovHrRooqQFozf7GDW8Mjiu7ChZP9zx2H8JB/AAEFuWMwGV4AHICYdS9lOl/v+cDhgsnXdeuKEuxHhYlRxuRxJk/f17Sm/5H85UIzlu85wi3q/DW2FTZnlw4iJLnL6FArUIMzuBOZyoEhh0SPR41Xc4kkucDhnENybTZSR/yDzb0P1B7qjZ4GqcSEFja/hm/LH1oKJzZg8MEqeUoKYCUdVv9ek4IUGUONtVs53V5SOwFWR/nVuDk2BENr7NadYYVtu6MjBwgjso7NuhoNxVwIEP3BW67OQ8bxfNBtJJQNJejAhgZiqJItI9ucAfjQ== db48x@anglachel"
+ & Apt.installed ["sudo"]
+ & Ssh.noPasswords
+ & IABak.gitServer monsters
+ & IABak.registrationServer monsters
+ & IABak.graphiteServer
+ & IABak.publicFace
+ where
+ admins = map User ["joey", "db48x"]
+
+ --' __|II| ,.
+ ---- __|II|II|__ ( \_,/\
+--'-------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'-.-'-
+-------------------------- | [Containers] / --------------------------
+-------------------------- : / ---------------------------
+--------------------------- \____, o ,' ----------------------------
+---------------------------- '--,___________,' -----------------------------
+
+-- Simple web server, publishing the outside host's /var/www
+webserver :: Systemd.Container
+webserver = Systemd.debContainer "webserver" $ props
+ & standardContainer (Stable "jessie")
+ & Systemd.bind "/var/www"
+ & Apache.installed
+
+-- My own openid provider. Uses php, so containerized for security
+-- and administrative sanity.
+openidProvider :: Systemd.Container
+openidProvider = Systemd.debContainer "openid-provider" $ props
+ & standardContainer (Stable "jessie")
+ & alias hn
+ & OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8081))
+ where
+ hn = "openid.kitenet.net"
+
+-- Exhibit: kite's 90's website on port 1994.
+ancientKitenet :: Systemd.Container
+ancientKitenet = Systemd.debContainer "ancient-kitenet" $ props
+ & standardContainer (Stable "jessie")
+ & alias hn
+ & Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html"
+ (Just "remotes/origin/old-kitenet.net")
+ & Apache.installed
+ & Apache.listenPorts [p]
+ & Apache.virtualHost hn p "/var/www/html"
+ & Apache.siteDisabled "000-default"
+ where
+ p = Port 1994
+ hn = "ancient.kitenet.net"
+
+oldusenetShellBox :: Systemd.Container
+oldusenetShellBox = Systemd.debContainer "oldusenet-shellbox" $ props
+ & standardContainer (Stable "jessie")
+ & alias "shell.olduse.net"
+ & JoeySites.oldUseNetShellBox
+
+kiteShellBox :: Systemd.Container
+kiteShellBox = Systemd.debContainer "kiteshellbox" $ props
+ & standardContainer (Stable "jessie")
+ & JoeySites.kiteShellBox
+
+type Motd = [String]
+
+-- This is my standard system setup.
+standardSystem :: DebianSuite -> Architecture -> Motd -> Property (HasInfo + Debian)
+standardSystem suite arch motd =
+ standardSystemUnhardened suite arch motd
+ `before` Ssh.noPasswords
+
+standardSystemUnhardened :: DebianSuite -> Architecture -> Motd -> Property (HasInfo + Debian)
+standardSystemUnhardened suite arch motd = propertyList "standard system" $ props
+ & osDebian suite arch
+ & Hostname.sane
+ & Hostname.searchDomain
+ & File.hasContent "/etc/motd" ("":motd++[""])
+ & Apt.stdSourcesList `onChange` Apt.upgrade
+ & Apt.cacheCleaned
+ & Apt.installed ["etckeeper"]
+ & Apt.installed ["ssh", "mosh"]
+ & GitHome.installedFor (User "root")
+ & User.hasSomePassword (User "root")
+ & User.accountFor (User "joey")
+ & User.hasSomePassword (User "joey")
+ & Sudo.enabledFor (User "joey")
+ & GitHome.installedFor (User "joey")
+ & Apt.installed ["vim", "screen", "less"]
+ & Cron.runPropellor (Cron.Times "30 * * * *")
+ -- I use postfix, or no MTA.
+ & Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]
+ `onChange` Apt.autoRemove
+ -- At least until system integration catches up, revert
+ -- systemd 230's behavior of enabling this property by default.
+ ! Systemd.killUserProcesses
+
+-- This is my standard container setup, Featuring automatic upgrades.
+standardContainer :: DebianSuite -> Property (HasInfo + Debian)
+standardContainer suite = propertyList "standard container" $ props
+ & osDebian suite "amd64"
+ & Apt.stdSourcesList `onChange` Apt.upgrade
+ & Apt.unattendedUpgrades
+ & Apt.cacheCleaned
+
+myDnsSecondary :: Property (HasInfo + DebianLike)
+myDnsSecondary = propertyList "dns secondary for all my domains" $ props
+ & Dns.secondary hosts "kitenet.net"
+ & Dns.secondary hosts "joeyh.name"
+ & Dns.secondary hosts "ikiwiki.info"
+ & Dns.secondary hosts "olduse.net"
+
+branchableSecondary :: RevertableProperty (HasInfo + DebianLike) DebianLike
+branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"
+
+-- Currently using kite (ns4) as primary with secondaries
+-- elephant (ns3) and gandi.
+-- kite handles all mail.
+myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
+myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly Nothing) else Dns.primary) hosts domain
+ (Dns.mkSOA "ns4.kitenet.net" 100) $
+ [ (RootDomain, NS $ AbsDomain "ns4.kitenet.net")
+ , (RootDomain, NS $ AbsDomain "ns3.kitenet.net")
+ , (RootDomain, NS $ AbsDomain "ns6.gandi.net")
+ , (RootDomain, MX 0 $ AbsDomain "kitenet.net")
+ , (RootDomain, TXT "v=spf1 a a:kitenet.net ~all")
+ , JoeySites.domainKey
+ ] ++ extras
+
+
+monsters :: [Host] -- Systems I don't manage with propellor,
+monsters = -- but do want to track their public keys etc.
+ [ host "usw-s002.rsync.net" $ props
+ & Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd"
+ , host "github.com" $ props
+ & Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="
+ , host "gitlab.com" $ props
+ & Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY="
+ , host "ns6.gandi.net" $ props
+ & ipv4 "217.70.177.40"
+ , host "turtle.kitenet.net" $ props
+ & ipv4 "67.223.19.96"
+ & ipv6 "2001:4978:f:2d9::2"
+ , host "mouse.kitenet.net" $ props
+ & ipv6 "2001:4830:1600:492::2"
+ , host "animx" $ props
+ & ipv4 "76.7.162.101"
+ & ipv4 "76.7.162.186"
+ ]
+
+
+
+ -- o
+ -- ___ o o
+ {-----\ / o \ ___o o
+ { \ __ \ / _ (X___>-- __o
+ _____________________{ ______\___ \__/ | \__/ \____ |X__>
+ < \___//|\\___/\ \____________ _
+ \ ___/ | \___ # # \ (-)
+ \ O O O # | \ # >=)
+ \______________________________# # / #__________________/ (-}
+
+
diff --git a/privdata/.joeyconfig/README b/privdata/.joeyconfig/README
new file mode 100644
index 00000000..6cc73b89
--- /dev/null
+++ b/privdata/.joeyconfig/README
@@ -0,0 +1,8 @@
+This is the privdata used by propellor's author, Joey Hess.
+
+While it has lots of important data in it, it's thankfully encrypted, so
+you can't read it.
+
+If you're bothered by this directory cluttering up your clone of propellor,
+feel free to delete it. Just don't expect Joey to merge any branches that
+delete it.
diff --git a/privdata/.joeyconfig/keyring.gpg b/privdata/.joeyconfig/keyring.gpg
new file mode 100644
index 00000000..01dd24e7
--- /dev/null
+++ b/privdata/.joeyconfig/keyring.gpg
Binary files differ
diff --git a/privdata/.joeyconfig/privdata.gpg b/privdata/.joeyconfig/privdata.gpg
new file mode 100644
index 00000000..027c5972
--- /dev/null
+++ b/privdata/.joeyconfig/privdata.gpg
@@ -0,0 +1,1343 @@
+-----BEGIN PGP MESSAGE-----
+Version: GnuPG v1
+
+hQIMA7ODiaEXBlRZARAAibMc8dMCIWOIKLWMsEoBrDvoc7JNr+nEMwwkZ38jtLmX
+nGmZIvsGSyoRySdf58vtGptFMCesI9mLWMduYdcG3xl/J37QchHsY6RqP+ENIlHs
+AbuBoAKknVbTOmirPJ0TDz770OJ146a8OwmCkhDfw33Yp82I4G9qD0cyDGpRamiO
+pm2e7yu+oib+hWaRhALKjaj1+JK04nQyLlQ1aYCpqLuavCsVdfUR6ZmA4UFmzEx+
+MUYB9V0cpJM/beaBIJ8T+70m576NiisTKJ1XKAbUx3QHPFkNCVBa+ks1Vz6QcW29
+tk014xdecKTkm7ACNZkRmBPOhg5dYXv0mEWwCaI3Hib8qLfzF4E3x5O8sX9SP+Da
+90Lngi+q3r7KaQx8HJx7sVkZe+Lnqs/VqekK2Q/PZZOadu9fwuz4p06n5ym9V5Qu
+JnIzXATRrUOS90rEKjOvvtAI454q7oihQhBpEQxH7Hq0D+kxKr+FKAz7yrct+XFg
+rMLkiz6rzDfe6Zwb7kQ2bD6TraYS6t5Y2K49QByw0IqOjaYWun3YdQlUNvHVErqW
+UICAT8fhOSj4FRvXPy6bt3JulPZRshcu0PGGpcidQ0gWGnrtomyOFyOg4MA1dTMZ
+14FG9vMIHA66vc6+9U5nnJdWFTid4Wi1Vu0pHbXH/6m9z30NxU1oIAROE0wD8OTS
+7QHBgxzmHKYRmZj4yMlEXNdGaZb5i++oVQCdBfHaAmZA6BhhqjL9TCast3LZNAfV
+nujlcF/6Uld1fI0dlqTyZ4uMmfCiV6kmsyq8h5/NI33AffOkN4MMUSLnsS6nTJhG
+3d0QJLgYm5MBvzpvHYmry+ji4g1WpxasboiGNqoTgKbEpuZdHEDWeUXh/3ZVQ90R
+a1+FKA+RM4x5koN4uvonzn5LR8QZEDAMP22ZluQY8/L9uy+TtQ7QcRagMl+2myNS
+zNL7xsW38z6A2KjavDYh6G1EYsujqFqDsRVUjjL38sYo+l3MpconFJ6SXxtRBQcd
+nM3X3w9xPiVIGbp1YvffMtwmpEUdpdos3OTon4MjXY2+7HfM4atU7my+qOwv8nSy
+GXCbwYby8qAEhZJQyE/lnfwdBicYD3wRYZ0s3syx4f0Nu9KKP/AoI6crZM1nNX9/
+UNwZYL0S53RE96wvSqPNnxwTPITNAxzPSyd+apbKpC/oirP9iA7xDwA1sQIjPHb6
+ALja6xnVFZAbpO0nd+BZTG8ik6b1BN7Qd+e4AePrfuX55fKOTtcmNKKAZyPTcYJe
+1bwC/IKLMSXo7jJHaqmwX4WjZabKx+s7Xkl+D8sW/H+CRfKhNV93KLCHrILxFQgV
+ozmLD/rH2CMy8iB/95n3u7Gp+lQJXCUDtzizpQxJ1YPkqrzYPbMz8i3OVq4/1Ggl
+2+M7upWgjWh0kZBQFWTtb1SwlX4p1LZfvaNRaRFO5sBJFklJuqfsAhU+lKtvdo0A
+carjRofbDLlEptFtH7XhFqAZPeCwnZGLjqG1kVreCYsp1d0XC4yBkXoAu2XQiGh/
+Eql2DlOIM35a6TotKyve4gWRAEIbn8yeP932vwqNLzhuQVU1/mpobAWUcKptiIuQ
+DDKwdZ8vaDtKOLPxoXqO6ST2VmM/DhVSWkk1HkKTInY5XfVCXKY8XEhFbNGPNXyq
+MJRRI4uARGPKBboMW2tFHDlVPCeNsFah3A+8F2RTwaz4nfLKpBHZqUiNDVVmYEYz
+ayHMqcZEcGwY5KxKw4lmx0trnE1vXlJPujhRrzOjzuVxYu0OGq+W6qmVRx9h/USi
+kPXlib/DYqWz4gm1rRCX70Qb4tbILuJmZAFXNo7kYJrb8+4VKhHH49r35rF9DAt6
+HzNa990g7/noZ760PDRFaf6OQh6HhW4dCRIMevmvNqLpgKi4f82NWgXfUel4jdea
++eHpOmg7g0xefQ2ff8T+6OoaEbFXmm1ODI7YMfWnbR9o4SM+SimA23MyCh3iACUV
+mh8g5udw2/VsqF2I6tA02UYAI+nfa7D8mskTvYUhISEcZ8hFhu/7JwNljUFwilN7
+1m72K7SBnpA8fbUkwoOhWgSymsmy4gILT1zeyMAPwmi9T1REesVip6peN6v3uf2L
+Ejx3ymdADY6kZFrQ2QWwxbXhjFz67DK8iA0LVvHjBa+PmDunFwiO+etBfhqkPMOx
+2bmGLV7XkZ2dPeEVKn8MGUcjuiYNfh4oo/eGyqx5KD5pG8EC+ZcP1+CSqrEzIdiE
+Dp9O0HzXPNQV4tUd2WhaSt4mbU8bW/v4wdpNxi+VtMURx7tneN94dRnvwuvsmLFG
+I07kvnTRI9MCa2OpJSqodAvQuLjRZq0eD7RMmWRNyZ7OhaI47tSJ0rv5D74SZo5e
+KQ+iqgGZfD25iHqgWQgf3rqxllCYp1T9lKwybfYgc4YGNGLbL48B0ddrVP3tEiwy
+h3vOzhzRwWLhqXUl4QivVcL4HdsGbMBQjJg+9HDlJ/8RzXAnR9fInj/gcaq1jykc
+QlusAgm1+nhHf/iq46u56yq7ndIo52Sj5AgDizOZ6AAlPJKY6DxbxIa7gt7leP05
+eY1KW/U8eVK5RPUIvVmwirILPCbj+ophM+AkzwS3ESWMxrBxQV0JN0ZBn1qKFWFZ
+XrFI9KZ1rzq/C2mU8yByMYXllzipnuCTjMXfa0J+UP5qIYXjkWI14KBoEt773vVS
+Ie5ObFOCNacd63n8mysStM34kIBEIZwpzWNe1uhyJ+gSLMVVQ0GQsjCn5wfMotaR
+bE10FATXyt3HBO2TKV7QCfFwtBGa35lxaX3OEns9Yjb2R71BfqIiX2otLW0qFMt6
+uQyTqslKV2Q/OPuit/eUOYbcWEeSVAx0SgHBxro9lWAsjFXy/jxn72ZDYzbd5Y+X
+8zCZ7opvkQYt5YynTtP5bOsp2wvqXUEcv3M6bK9SoC9kgHXljuSk/t2kIX4hdCIA
+wedCxmDlVmAgq/Q1pbGkmGefd7Cj2G4I7nGpx71tSIKxgTfNsBS1yQ5aABJ7WdX2
+BBsDPv5A488b4V/x2gU6WS1MNGg/GUcRt01HDd+UYRg8BMi1fC0sYn0fZbzu9nz4
+MYJ28G6gvvuEPGlv3I0yKhSJRlzM3Q3Cen9n6eduHjQkb/czDq6V3wU+7x/M8sHg
+iP5faqNoxBYqLxz4jdUzdn1w/1thVbchlYkt4djf+VpNWnWWQuUJUwykM44LnjPl
+rewc1qBIt0SmbM8GUYfE8JFYoegi/DxA5lOnzaUcPD38C8w6epkODYNjPdTDJSv5
+Tuq74kvXuYKst1Hmcejvs40hmX9dRiMG2ppdB7MNKomrP5wb5lRy+TTVLYQQcW2n
+YpeZqzSRD2/RBSDt1faeBQqocOZAWJVxVZTYGHbUqZs9cVGd8Be+hIatBFDDiheb
+qzoXEadmqKJILWZ8b5UFape0Utkax57YPP5J/ydTnhG/2xDDHJSmLzte+hfCblJE
+q4YCCITlYTZP14gWwUHpnUb4nX+Q5vYEqoDcpS85LP2sFCunYrEWSksLE+j2RfR2
+K96smkwsleNdcYVvEinZRgy3N/psePUGzMHQopJOkDWiJeNsbeOI2jvBDDgAfHNZ
+ycbdz3NKa0tGqqHI6U1VATkjaw/l0voFdgRiOYd5b3AMn+HY9skXBuS0XMlsUtYz
+4/pGGtFq74CF9ACtFO0dWNrVuVJHjZeKxpBQkyNTiHl2ZfphgvNZbCgUenQ0WlT0
+4awmC4ysNtpF51rMtooi1nIylarlgxvoVzCnSd4vnkiXPBgHMykUW+yVgt31KyrK
+/T6aFEuTqH/KlvnacwnjVVLe4xbHOJLa6BRycXvQuD9FW+BGIAmqNgliCEVl3wy1
+/R4PDgxz471+Gz478n/hZdM6uONVxCuzAWPVpwqlyJExrKkRf75tGy7FFYfujC3C
+NCNKBQaHDImQpjIvwOY2WhPmObT4Kzwn0AdWaBtPgMD0ijv+ux3umacJWev3aImN
+5Lt1k9xTN2alPtSwBPw9CHoxV6MKuVTxPfAo1dmCFUn1ZU2Xoyx0lNqBVsgzzOZt
+ounszDfVwIXL0cQbEhj8H9wzTOvfYFWdIYXH2IERfCU37GSpMDfBGy/7dqDUrJJh
+Jho9R2oORSxHbUEt0uGjhlLBjykzQIV0qVcTZEbqVJtJUcrchTT7N//zs9KMjVIn
+NMo3lWv2dn07w8/T9MDy+e9rFMfo5ehq+sTDWmlnEVpVuFuaOQvLr8rvghHuTDex
+YxNZAFQUzYXWJ7Uxa0JRJULO9IQzi0sUvMBymFSVwso4W/T7xKiQ+tQepDeb40hW
+ZQyHl+EeaUMsbj0YU4lEgHiehRMUjQ5es8teIufJ1EWeSDdrx8LOI8Cjh5PZoLX8
+Wv/5ExI0ii1sYn2OnPgd/DnnvJ9cDMNIkxrQXHgnZECGYaaMZgAXT9rvF/iONU4F
+eGvqBwe9nLEDxe1DaRX+KRHMqV8qCQiwVu7vmehe/4E4z8rrbsDEZz9bW9lfw7H7
+FJMT6NH9TTyOWybOUYfNjcyztguZN0VXeL5UsGizzRt0OAfu//sFCD14HHu9qd9G
+Y6Nzs8U+NYk+s9FMzqGur7usBDvQdjgJSVUrSz5ZZ5HQrc3jHHHWfVLnEOrhF2ZT
+1fP+fM/hxCaMAGkgJkdnGGhXsHmXdFuoWRRMrfz5Ta4NWeuZjg3PgsCzctg+1vrA
+Dl88WA6hE7x0zkcrQdJ4l4riYrCBdsh3HD+Cn6rXtXtJfyGSRDfhWVWZSwZhyK+1
+uRWtGvB0s0uGupJdbIuO7FwsdsdPPzwoaynsDWS+2ZeE6cVoHk30W2QJMj9ck0ir
+i9mKbwDLoUWodX6hqgDO4kEPRLv5mEOEbLDFH4Reaqokd8jLxGVftPpb/nTZzgMT
+hvhb5fqohTDhj9SHfBN6u0TcNDhXQolnLESsUZF2ux6QOf34ttuzOomjnZC7R17k
+cxzcR5Yy8I2D/UrTRKiHKMtu7QWpQ/lkYpNuQ31p3+tRMRWsfYdObngK8SqcT8pH
+rVencegbi/DxRe7ifpo4mDJ/9x3sRCk5CPY1Oy20LEK7yqtxu/ElTT+xsRIj9Alj
+JxgjhY1ECQcg5GNVqTsj3VmjjtSO7O2sO0TAorfaVqrLfmwnRqrY0aQQ6G6gF8zg
+Olzv3qudNatm2Co5ucIZbuo3/XppdrgoFMMLc3ym6t4cXKmB0GLM8Le+QulH2PJV
+imBYK0LBr1eaZrJ5XPyoUm60QD9jqDjAkTj5WWDvlXwv43tN+noO8Y7EN0wEE5yJ
+QHEvyxvmVMWfXqzv+MGA4lfMfqxNsBjM/KwU5/IlfrwxeFRu+wjdoj7RHLRPnE7E
+Cktg0wJ+lgPdsAgSPQITDsk1ebGsovaX1Xwn9f3ke/8aFB9evUtA+VD9i/c2PFlf
+AJ7UoXSBRPRlL0imAViK8Xz+S8rr+OO3kH4LFerC54EN5ylhOBIt9qnr7dtVk/0B
+nHpndh/PNOJeH2XTMc0LgApeWMcFzHVQo9OAFE6L/wKqjceSdXB5p//REabtNsW6
+8xUE0bY3h7nC6opMNB+mDweoO8ahXRn0Pm7K4LDNpH7tmX9OtPHynbD4Bj4kkOjM
+bri46nTaVU41+aJcKjCqUZYMeSmdlU6+H3pUyy4cI9vB/D+n2n8yBItfXiKHJMzq
+jL6NcD+asuyv61g+i4jU7OQa8Jh9rqwjOthA+3NBfLNSEPvCFIt1gYtPOpaqqeWh
+Y7NooHDPPFJ1xf9vb82v7p8vavUXa85+vng1uW83gA3L5iHpEqNm2lQRoHlGrRjU
+WdT93MNDjaHh+9xpgi+bPp1d/xEfOC7UlXXzRGLKnvS5ARjjyLDuUto18cVKEDCj
+MEtaV0mTW52+/DgDyXc8krRZtDj8uCBXdqrS41O5RyN2wnQc9LiULsk4wx3X+7Eu
+S1xNDMPIxBqZiE50qBB2dAswg57DJKYSY0F4s+842PGWMpd/cZv795A7rQIdT5bk
+Pcm3II4OtGxKX50TY//b7a2jCH3tyCxIen3dj2zFo3IWSIz/kGTUBKqVQcqHvou3
+UmBYdg5soItc0lb3dhOW/EFLoTyZWTlpt+f7NFIE2hAMjE+cnZlE54ET7VXZJM86
+KkNyBZEaZJWwPdYIfSVBusVB77vhthTz8hiiE/6SjqtSjvsHm/wBWBg4rX6m7hR6
+TDTBFvqVLxwYlbSU/KDFesMf+AoBrk9YJIGZvlt2EGpQflar26fhSisoxwG41vdo
+hkHbfCpdRyaXayJ+MCy9brAX+tHzStEoKoIrtqMe/bna12sL2ZBIzWhTNk68ylu5
+/iND7RNY5hk5WnfnYWPP0uG5L4EZzIKoxWEpRKfnTRAUed81QuXDqiCBg48gNZx9
+0O1k4LMKlp/RrbubK+ImIAijfvOGS+oqLTNWbuUBNOyNeMrnUATQEOZ8aXuaS2Cv
+b2isxXBeg08HPdAV4WHTSdt7K/FrVSw+bJDXfp191iiWH/ZPJU64ngTGKskH5CE3
+VUGhcOlDeHg2koDejJ5zgjsD0fvozGMhuRpZEH/WJnF4ZRh4wbWIedEU2abglg2o
+8uHvTAgooKJNbThL7HuCDO9QAlZ0lkIEUAH/kwCwRYvCInSGi7ClJpDig9o13hzZ
+W1CqGByKKreQ0YAEdMujzKESzjTO/hpxCrgCk9BF6Y8EMRnItDM8Kn5o7Hmqu5v8
+uMPOwFUW9gglR1qel1GGC7R06l+uISXpFE7mlPWjQqJCyA46TOeXUn2trWSFJHij
+9Nl7nUtDp3+hWGgFkLVUYWZD7S3jQPA2KwYSOLaf3X+Xe5XyGhvZPTgKneyoch6d
+qzS5B++yti/mZy5X4Swfct/6W5Xsrr7z0HKnuKkeq7Msb78l/gn+MvJX2M+JTTrC
+ehIyjyVEB143AzRhxIVHq48d6h9BIsKi0isUOP3ZP35lZy40O9KdgIkmrHLmw6MV
+iqwMSG1Di/4fSxnTV6ooMN5dP0Yxy59xcC23OaIE6oDyTi+zziFOZ47MJxP8YgPf
+i5yrG+qTW/T6KWzIXFqcuiMAwmUSNCJgpRD387KUYLu9y+Huh7JhJFARxiv8hM5o
+O+zQIJ7squ4P1lOcId1rue1loxfHhNGcKQ1kFKfer440Q0U6a0LQSQwxvCxJb2G+
+92PZsz8jkKdaisNVhKcI/NM2KCcmqvjg1bEFZD69Vt1mQmZx9YQvSC0mzWXnBEGw
+Sff9eocERRqH0o5LIILpTQjFDbZSR7oGDPmj2V3cfF2yMDGvjEQKIZ9VPQLeW8FL
+9jrSugzxmQzidZVk7fd7e6ZemQuRr2aMT5ZQBFSe0UEaY8onBJYXNRGep1E5mHqM
+ORZeguMW+UacpPF6l5ComwlujbjXFS8td7djavWcrncNumXwbavLYoJucKXUQvFa
+w/rWtBlOPbrv1j150RH38koqPjYKlhlFiIvX8PtBRjDD+pw7/8mA+Jl2IAwoYGXz
+M2WGGp/eOtMgrCuq+IMllNCaGmr63xttXe1nvWLabgUtN5OObNiJzM4tpLaZzXuK
+T98KflcwbUDo4jXNaa3Gav85aZpeRgn8o4UWsOXjIocxt8yqXdScXHXbkV2IKw2+
+TDTfHZYws7HvbBoNAaDXYlKX1bjHesZVEJOJv+UNKWItgv63x+nhUVj1OODImsKE
+mx1/JNpxTblKBxZTCcid3IQhywo7B7RSx6PXeyvQ+V4kSOUAHbvtI2gcHODLRJUR
+wHR/5t1YZFKDuNUwXxVFUeSy5BoGDlIFKBieTydfDV5OFXg3onqEbbKDWAwAjHok
+OF5g2h3K3Nfi2kr6ApyH0w3iAbhIpnyX7LjNwuwZ9w60i4oHeLKzzDb/cZI59ekK
+X9GI6ZzelJ3JH4MLQIqdmWLMGuMtiqnfCmuvrZcubEZWKXKBOIELzrhX1u55DIE1
+4wmhza4wI+7TjvvmsEj24XGfYmtucuI0+np3o5g8me+Qcc6yk+u0r0HBw8jQXrIJ
+FLNpu+iRfsBGZkVvpEeM6s6EQMm6ydGees3VA1Raf9hZAE9ZMF7zZYVRQp+VOOGF
+3V2xfPL+0exOIeZUFZ2i73gsNKDuz1zhW1Z9/Sl43jwzBRAx9tB2cK+Y3om8SUty
+Ta7HADf/Swr/gxUO7XjOe5nZglW6HfxhpILZj8s1RVEvcXQ3lEqXOOIkpcdGRmmu
+AdtiEPUiAgWgHIQOXfRCD+Lqn1a7VOiA5vCUdh/cJ/9ABzRnmem0r2QAWc6w0OD3
+8gCjOMeTgUnSiUMjOdZXw4WAyLGU6e41P719tXZLn8nk5q3VkwK1dOu7o9rbQ312
+HVM81d0ai8JF23+5v+crs5PVM9azHOEsuUm5VlPlqtAWXR9fUGipXDxVA8GbJUUm
+o09BZMTAg/d//jO+Sflq7eVWdjdVbagdVHqxvsIdQ/naMBCMNHySnFrpWzl41HqI
+gDrB86F3ZZV4Bps+zG1UkZgNagXgeNBt/hMw1jg1MoT0QahQ6m2nsp+h2manO+Td
+HsYLPveP70n+HODi0tp9FDbpUJw8DlMXfaxKAZjAfX2OfkVbwG64Q5mJR9ztEEQV
+zZs2+XUA3+IgoCOW5UYv+YskBPbXapKvYH+Jcvzi1M2QkYBHZOetLbJ/UArwpwVs
+N+Odua8r7E8Rmhuq3Zc0aolWR5Q91Vt898dT3+ZENFTNa10oqy1esi9EulwNIUig
+fRUvtFUWmxJww6eT5n8Gm/kgZKI7GNIZ73ZMFT37tdhFkQqcPHQmEWkJ7o0CrCJW
+jaizd8T08bXQZPM9LSjL+8y841CXAl1LTQneXylHWEnQkRuEVW8E1Jj6yGFCGcwc
+mzo2KXnSqZBJ1ZSJrFTx8EyETxtdL4z4KiNZbNmLgXHLZhK+HMS4O/yVPDTe0Aa+
+BnQcEgFN/FEWusetRG9zbwQG3MEnlThas3vIeDKBLrwCjmzNncUPYfbhbZvq/i93
+tCCUgzwUbQ9p9cZdH/SHJVJDMz9jQPNXOlzbOW+9frfKoVTStcv0ADXv1iqdn232
+Xx7APEIK6sJIDWm7AwO0IJ8mK1T2mXmGfG4pK8zfxoPUwvfSaIPY9MiEqO5nUR52
+79qcEFUHb8x+hXbmxxY79tLqFrXFuQJ81ar2NIqy2I1IJgwAwuVSx70CtATrSPkI
+VJh+f9ktFuUUnzJQ3Z7/0P24rFWnt18BKv0Ajm1kpsLieCGUsadNMjwzfLzmt0ro
+MNEmSJPCDtRwgqItw53d1yAln9TR5R4zopBaBLW/AX/nh40u7tKdUu5Jc4W3FA6A
+t4gVvdOOqHw6YPEPhGRN0LgBFhHN0vNJ0RHQYL7Y8pXP3Kz++Aq3JdeiTkqX9JH+
+T1NcH4spbjQdQhFREfQj740IvMv3EIctvTgrzW6v1sn7YkSGJnbbi2HcBXptdx+h
+Z4wCuUJg+FH60Hk8TitqMUarLghOhXCYAPb0DtsOK7715pJzeTDIgNkcoz+eidhF
+UKn6XX9G1mhPOvxGDiED7CYUogLyMrzxQfyi2taxoUEbjs6TNux87TDdo1wwumXI
+cxG15m4UGLCYf115eH4lQG/oC7zFplvVCVsO2llZeYKJVl6B96sFCp8lY7PGQHqc
+ZJnGRkel5No9jL+fldmK9d9NcPJMVzvooBLwsAl+H/tfe+TM6q4+1qfANAEhPnId
+qQexGWjJo+XIT7vHees1uSAxb9Hyw7FpcgdQHBmHX/Cjd4DmnvWo0/d1pZhJAInW
+tuHcHpUvALKvRLQN6ZMHxlcorucrWmi4MJMp3fxO7c3omjnyKqn3pdGnIxjgdVwI
+Y4ut0YlmvOKX/64c5vxaK8ODUmUfY6bk1nMJ2flfghMMgDYIvnljAvyUAivh0jvl
+DQe+frWsujWQjGxrr1E6eeYh7YYuV9w9jzkZjvLEXkTxLL/zcWyqRqgnpnHAaOMJ
+FmtFDyONUhkf/c9mcmraE4eESjc650RBOWwoxhlIAgCdIluOwvShJQi8KO2/SqF3
+NkGsNAoCzsNP3Ri6cq5DUYVLl94wsfQtGu9DufQzeOUeojGzHYMTqgxiJjkTP6bw
+2JkZNS1gBjpurALkJGTIheOC+HTxwYbwtrPPURlhPq4gMu4DMmfwYDegCCuSiezT
+85LefcoX8j6c9sSBMbB6sGmNvS/mIYp3QodTrtA2TSVz7H0QsmdMP5nrlook9SBY
+uEayFCDBIKqw+xds/8hQwmEI5FM3V6HjklVILUzRZHtcjUvZPA1cvk+Swyn9gsfa
+lrkAW8s1qZxv6/kfVY8RIKLi9tak5WMSCyqXHApI0WGM0sAbfk41a/kKLBj7pBYC
+qeY5HMEz/EuJe/TOjE2kKHjOtXxL/vnjTxMXM1Fpsglj4l6EGYmRf5AWxCM9He+E
++u1H3FVMfC1kX9Ipn14v5N3defy38oRxosN3lHqCgAL/s89vPNY+9nJLBHi7CiB+
+dJw2v0ncMUWKCOknz3uqjhACWJt+QxlUwlWmlgtZ0k3raYVKfwML6jfstIt84EyJ
+E9ydqVkG60VGHlLCTjq8V5dXGTZ6NcNsIgo7IeKa47UBt6n3+uN7lr78DiBCFRcv
+s+K5IyIV67c5y5KRLreTuKfgiM8DuiJtOVPXmIrYIq8KNSpwwlshxOW5Z5hap8Pw
+TDrQhL7MGaiNBjIhGuF2oLRMMZkqOyXIE9twkIeUVwK8FgkaFSQed8qOEh5cjfBF
+VCXyuT9S+lmrKozCa1UFwet9fn8PMkSNNAmUpnkURBahtB7egyszYh7fdX0d8Ofn
+eVWf2sCgJaptLPSYSzvAieha5Xc4uLB7MP0xWG3kHqmFpzP6ZYZyAl1my96fMKgL
+OYko8I+PLoTCFR4FMVGVeNUuc6kUROMHI/UmWssUEIw/e7m1gQ5va5K5tGu1baEB
+yxmMM6/K2S/uyuEMijZGOFsp7tJKTVqt9P9bkAP0ehA/HFcWoQOmvtK220832Ag/
+y6SWvUp5EKvKxF2PTI37WE844opfCcznZQ6MTXGa+M6FdYElPKr+EwMnORx4bkzl
+evCFbz1zDa53b/QBlynINYbYzcC93PjacUxnPXxpBgIz62VLlH+IcA+2nCLQWyDt
++LdsIhb/OXFf5TtFZOUfQaczXExb5jmhb30hfuChGjyhMtDjCvqj5v5h8R+Nm5pS
+bcGOJScyjvujYFbf532ydmNpsRCM0pi1PPlwXzhGnU9mNp5JmxS2wCx6tfZWIaac
+yOmQZy32BH1TMaRYJivRHFLGzVkxct9r/3CI4cnvv6oEnKo+GMNRlHRsOw5457jU
+2wFOgruZDSoDhD8/+ufOmat0AnMUV1btVzIRjGFZxiNUWZ+a25tOCALyuFUUa8Z0
+6YGgtBtXkFxZghEGPhOaBq9vUbRPyrOi/1qhAnYJDJp7yqY0eDTg/lW85UAUDxmq
+mmRpHsvBDJVHqWrwL3b13pwhtEiiiWpovbeL3gRcD+vbYYN09mpiygTC5vRXbUX7
+8xRONmqz8z5AQtU2DE7jXNIn+R02Jjt7NB+ODqMhB1gB9r0Jo0oPB9r9KYoR5s2R
+TO/uYn+iErbhWIxDnnEh7oJ6AFi9y2IerRLgeY1sPQQn7yCc8dPThNnh7fgp1JHj
+iXEZ752eLHuOq2skQsrpu58s/62aqHzbAAxldJKVwRa3KMyHQcVoH6hLQjX4Gjda
+04p/8clCAlN6LuacDjyYWVLBDWlwln41o39Leg+eYBIS7TBkqIADB7wCBkuAP3Rd
+fY+3jO61aJb2dnTWETQ30+BHY7rQU7HwPuDsZjhfm5brEX2MvV1W9arpn+TtQ6u2
+oXv1BtecTBt9Mxub4KCQO6i20+zGyuIBrpIwxQbauYul3Ow393G3pmhrZ1ePEfp3
+cQDLgFwakFV4gd6NlLnAkPPEokc3+NvK/gwqj2hJ5uvKEBwln/9zlja5PiLFTLc7
+sDNebwsxC8VNhK3MPhFHHVfP5d+xUBHjEMRPbHXZLubffeZx4TIbC+cUDREbjy6x
+565rAjt7LijAIfEgT3H0Tky+N9v2Zbf3RE+o/5ZmMnnwnFSPn+GGhqswzj1OqJ6d
+42575KG/504ybgdFV7ZJvnRQO/P0Fi803voFgDyKC4OQ3YBIR0MjfrfPZKgxGjpD
+WazGYo3JEVIU5S2MPZAfreFDASHl/yQ3E0liUpMmdNlULkB3M0KacUg3SRi0bEdo
+cgCuZZnFEPvCFLPh610WCIhgcQRNKhAdFuk4/947PtONLMpXcmMMgJ0s1neoQW8r
+sX4pwcq+c6Zy17WNhHmIbxUZ7YBmxRfNR9lsl4HDy8vnlaxsXXjNqj2znjcMcLIv
+GHlAmLZ2sKi2M+MD/8U4f0EwJUimJTwXwaN2nSL2MnFJB0+1b9JishCIotMSfi+1
+M5UgeshyZCNouVQ7Jp4c7EDkFc7/PPWij8xld6GiGrSI2o1R2PzWlGgrmmD4EOty
+wF+blFLd/t2QcehNZSQd3WsiLot5250NhPv0iZExNq06cBV/7z/mvix+i7z6XZMz
+t8p7xIACnCfhpFRWHobLwPs5NQFeadlCRozUF/dvUsnp95QUQD8ItDqK0ktjwuAv
+MCnIkEl84XIVtRcAjtbgajJgawOy11Ii1tUvZs+/ik0ma1qV+y3AG+UVsDOcFVwZ
+G5/P6y86evtL4oF8UsL8o65EeK50lmO7xpPJ1axQxMiksLHBfsy0Zpp531rRtE+o
+yoDm/sWiUrl2lbN0tsKp1xLqe+WRFlCML3EmixtCe9CAiOWgmfHlrdi6BEimqx5a
+6VcJ87Zy246/8/wgl3eQSkFzki7NcUJpJe49gKFhH2jgzz0Sxa9ogOkQ8hmzNkUO
+0JNBEtqUULqM9YaJ7YBCliP7aG/QiLEgVwcg4OEZ/t5FxPDdLMXquLWh6uiPpSkK
+JDgrLaJCBw98kAgFGxFOIKkv/ueqiIzsF1PSEuGgy1zS+ieiX7kZgT5J+zwK6YAl
+f21BaCiFYIl477nJNZYYAfT+sJeVIC50K7v3FqD+MAD9aAmBNKdOlzhK1zsEEg3O
+quF1YoSeGG/s+l16Qs8W4bEH7ByI8TOnTmc//lVcO+l7jlfnM5hcjeA0kgSJ4tiW
+XK91pWZp30VU8Bx1wva5rSuW/SYd2wD/wc1RsrXmilEjBXYzac1jW9KohXGkG4BL
+xbEitVXon9uJQbHwVe//QV+6eOuE3WPBpSBv4F933jwNlteJ75kYuf/sbOyrXGbu
+O4Pqu/mlXkV6OEGKXsVJPZvDgCK9m4nzWNGUdRNd3TLrHhjhnw7+F2uNsrxxbUv5
+UD2YfY4xDgBjq/49tDe/hcw4l8Z+IfEcz+er1ltdcFHM/lmtvlRMzN7pAbR59Pay
+GYuQ/B2e0JddUgneipLsBnbJixKka2iItYt1IdYO8pYEjNWXCioNcixqJ5WHYwx1
+CjKcoH+CpTForecWIIiWy5HX+ot+PFA01+KgAv0Sgr1ynHv1GuGuRvIOg+488Q/u
+FRdbFIUzUqSqI+BV/OhKvH2Oyj4tuhaHMs5YSTS23UK9Qzs+wCTY36/YbMIBu8e+
+5WCVmEDJo3olkaCXcSdSq9Fl+jD0cZHqJoIF0lr3VNMpaTEm/BI1iDbwbcFqweZr
+vDp1+PX4K4wTVVSLsK5HFF0QUgz6pEpwgAO3yZSy1aKYFnmMNJBsYwU0W1Jh3bgt
+hTBEtGq4N+16LOFCiN2mpkq3A2QhjjMrmWL4PwUN0LT6zqXydxa03pAmGlPmjCJb
+Tcp3/0Yu7PH9Vbpip7bujtVhnJyQ9u4gR/79iKn+tKVI3/CIyl73kq1Em+sZbJNm
+SaNs+7zjJPWb9UZETBxhcM2hsWSm4iMY1KnrLYZGWHOrr/P/Nm01Ds8BKSji0yRW
+KiY1sNXe/8SffJOGJNwv5x0S1hJo4l4mi/5TTos2faksVKNqKKARBF5dxt+hd1wQ
+GBamSGYpZUW39pjxW0uuDt6bQ7Js98VWoPWi/GrTPeF6GzBJ+SZUP6n1h2fBeZ1a
+ysts4qHv+8rKWLKY8sDtdARS0gnAVko3k36Xza5gSF846HnjrrBOkxxhsSbaU4Ng
+GV99KSk+M1ASB8ub7uUltjHK9PAXhWst30i/dX3f0x9GXNlKhrS/NI6ifDrtRN4r
+QRFDcGKk+bfpczzs4qLYANaV3aSdJWHaHGjdqbHj14sBPCTPdhFSBttEOA7EW1ij
+nGJp7aKp2Qr+97OTz1JhjQf2X/hXLzl6+e6AF3L1jya7+YOkfRI+TeF3rLwSvhSI
+plkXChG3jKzS3IV9TE2PMUywF7M+bVwIsAMO85zPp0V34f95vO2xB0dV/oTRWM5F
+7Kl9KKL5rviAf4tAvoDGWSAOH+pm0TBgIF7kaRFsl2IqFouc4k3ewKJNzVLXJYjp
+b9mh0TYukaBtv4ypJSithRJDKq6R9Q2k3GwMKAE2azFSJxazK9TXKq/l32GnPjeJ
+4yTsPKxIRub4iMPlaLFnxgxtOVwlQtKnzoY1VJiwrLncOPu+osnXKPBaGxv0LPBK
+B18e3sCywoC/1cSGN1mQGCDsAjrAOOpmurZIed1INeqeLuxoymJ8rAI4DXB/FEAs
+od8E+kPvwZR1TXST95MXpKJ/v/jLy07YT4cmt4y2iDJiWXSvxdh3LhsD7LFNItyg
+rBcuvMXmBEvQxnlrFPcBeK4YIvDUgzBNL/bRIlxDmfxjiJXq5r8ZowYaWWltXoLd
+W+ra/dVjG5S9IKD5wF0O6Y1bxaghKGuGOUP07ia59ghSKGzUl1qLDkrwRaoWNuWw
+OLSC1Uql+CkKJtKukAn8j9relF0lgtSOXk9ieQjmUshZNyeixYVQJrbDzqIzoC+F
+n36qARbLc5YtCSpCwyYK5VA/zaIvDv7X1sTUFnc/3x6kWXx4zMHicCcal0qccNe5
+/JBwyxAwykn61Bvgcbu112pkbHNblxV/BvoNjDHap8uCuqOhbF2aDSnMglcGPVIG
+rF3F64ZeiVNCx1HQpmMurIZ5nBXF9X4NmLr0sp9u2PaRQ1WKEGqZAHExSp+v2fSr
+8AtBS6oRQErVcrEzqM7e94DP+RcSiWeVvzi8NjAecbh85PCOeO2Lo0h6t/GDHeVR
+3Gfd0q+mhB6wneuXkSTU79zbEzCrJ0SGJNrtkZs9ciTX9fMj/OdhrscHan+LiLl4
+wKtwny4HUOkeyC/GfC6UOeJ6mK5d+a+3qu8hPUCVm38jHAVQJNqhT6hpwXOWk2lw
+Pv4inp1f5oEiVBsDAsb76ghEmoCY0eGqLGuUM4WyzEBIXnfEZciZ2h2QOZdWKvzA
+LaYIDDSuAGidSpmBKnakiU1ZJSThdONnPP6CVrxkQSFmQCQKMObv8c+eSyY3DreG
+yf1rEFiBrIJKMPKlAe7szQdKeY9+0gvMuONU+i5a7ETiwRkMO3TDgEyDuUnViMVC
+vTfvUsUHAEDY6ZYabauGlR/Em1MZzdHQWlLhYvOknauLLsSKwamfBvtlLR6Xqp8q
+cVFHS7GPjCgc6efYr9VeI36qryRDei3DMmXHwF3PXrn7yiuAbcs9s0x8NmtZa3lR
+tACm6eTBzyJi3PR5JEYODpn+WgPANWmkpB/qQCqJCu2uO6hQ/nuVfkUT0lwcArgh
+IOKZ+Pvmqz+I+dx+z2wORJHvz6GeZ0Krb9sgGQ0Yo1ZLmLp2mugiTjkrTfQK8eZ0
+en4LDKOBEsdrr2wPmUyZDW/EpdXCGDpeOfWwdG2OCMNgZpcu2RQOyiCatpe5yTM+
+oozYcnr1AjgufCgMpXkz4jKFUgpXWDZ9jWRBid4mb1UvLMwniUy+4+Qiq4pno8bC
+gBa5+1ZGTVvHdkzQMUaD7yDqk2r2hSEq40IMhWJqt0QTYvWf5d2VS3tJzCENM2SG
+tifBTFr4MjUKOfxjSJJHQ9OlbTYqUlMAgKyjRVAp0FUTAy/U2GZ7jXbco5IOvcZf
+K1wwRr72FpxCd+/+oOQ2qdi3+81+2skTkRGQc8rcssDFxHhamQTE0zIvnOgev89e
+1OqMWh9RHnfn1jIl1Eq6dIWemyfDEjuNvTFqpp6SRCz9lW+B7E9kmdvzHfUG+p3u
+D7/DqkVTzl/E+r3XU3WpRCMuS/S1vCqyebpwvbjFL0hxnVBIc+ikovl1rerIUsVs
+rZgm5hhSyoXZvcbmiPLOtdpK0JMHGiSlsN113IGrayxoVrFtEwwHeo4XLySvmoep
+UOwr04l4nTX2ZFDON9CXVv9k/ZIPJqRW5xTYsxehukrWzLwIFg+SS/Zq6wHDwL/9
+7yP+J4FbdSJBhi4iklN0dHtcNk/3jfDKmxOvmIx/NuE4a76d55/aB3Gh8P2Ka7RO
+r0dCO16X4vtUtdxGPRVRfj2E26Eg32cucwRhH7HyKoTDTkzK3JcOUEDBgcSSGFNB
+VZUIHELbxjJrYw0M5SsTi7uKl0XcPFmm9HAJ+tBuue8UkERGyCKQrm3/mmS24LI4
+7+rG6sjSHsNjzCF8GQHbFD4D9GpRdnpdrDvhLNtSHvEwDT8+QLKmrHDTCUxLvg6c
+DqVA0H1N1HkepT3Bp9Mpjy4HeD/t+kotA1S3izT+K/r78+RRSAggFchCTPS6CU7A
+DLTb5bVowargoQtGnGIS3X6wKw7T8OiSp9L8cWcfVpzk+QbPLCAy2xpxkFwLpgcg
+ZW9WBpj4EldH348QFXH4Be+H85OmD9rV+m6uh0kHjEff3J4qL3fza1zt2/PCpSe9
+zqZ9ZbGs4FbxRiRdjFwskIWBLp7SnL3RuANkeAkF/0ASHbDijB7Ct9TaVuyQq5cC
+Tk+BfZx4XpmU6Kmlp+2FI2nL0tvgYv44wb18yyvQ3iQXvqGxX9kR0AeN6sFAjgUC
+byoCJdVlYswGYhPDxkNTDJVf5gVmZKg7IkdmfjeM9u7zSi01QOfXW/E318O0xvLM
+5hTogFFw4aBDl5TMHHiJFce+z1bEric2T6kqkOXlocy6/Fl4duorCJdisemInd+1
+HyfC3n6e7dmYkGu7vw2X1v012LTdbsYaafKF7q3QIKZnjW9+fAo6elG6x79xEaBt
+/l02LEjwEAFc+bY5TxHeTz9ShPY96ysfqruD6j0kBWmrnUm+Ypv3jbdu/dlI4IMa
+wfO0uZNDN7PkQCNi24tf9ngU0ccx128H3keEtDtOVQj3VYa1LeRrrVpe4J51u5/2
+L9mCUVdB5WlPVawf2TQc9gzHsXjToAFSWo/kg0uXVlNTylf1cgAKsCc/xHwT7Dxr
+DLP7kD7VSdoCKTRDtn2yuYyOpgj6KYgzGqgnLlZYNRsLBUYBcNJxe81n6qN67SA6
+XBZ8UUrfAYlXt2M0Qp2oxIpKlVVgqZo+g5pLuZSJ3A8eAzDTQu3emBm/mzJ9nm+n
+5yGgSxo8VktVkyK7Jsn7fsVxmo2hSz4gx2nsIRB/Q4e0jt5JciLR5QmhVK8vBWr9
+kDMyjnASkxHFflN79aSDyNLxuYi0KjzXYpmuni3gEHaZeU/uu5haJsUdlXKJVyv6
+cGtccWswObrf1E6efii+hn+NzN85gT+Wkwi3QMY0UP8Qsix2QvvJUb/NT1jptiht
+uvLRl9ZNQ0NxB+IrVsD/V2hYyhVleDvSH/wyDk+5e+r2vKsBHAa1QN3QDodqIOA3
+VO7R9HVXzeJyFNXAWFwZPJuOEW8XjHpT2/1YrZBFc0VCRM4zUtStRTZ2T0a29OeI
+QgUv9ND0d+vHfxrfW3/t/fAysyrMMgrPdGdQWXGsAWNVjH1VhwuXLVKLQ8R8mMgz
+vElMSyaZPSM6Pgg4QVHlHCeTy1vfB2ZU7UAp5cq0Op15fqvNzS/z339mMeqeikvM
+Cz4/fC1iNSebZx1r3FtEZMzIPwJbCGkd2EpvxOE8R+1r2jUW3w0XctAjLvpacFe0
+ta0zhRO/CJay9Figs6FYmGSLPA06FpR1J18NC+fQOlwPfhERSndX02ZPKEHYY5KI
+rnAr13xC0Ad8lO/x8d8y4dHPdVc2SVd1gfMHfL5NzFosQpZDR14Vc5PDl+PM8v0b
+QhlPsyZxQ2yGdQs/iO+9GezihfigJUFLMqAb13FJ0ynmMc4MHVVaM1T5vhnAMmzZ
+iu08B1kvb0kSy9an2mn1MskxFP0qGySvcutAb6eLZYC1hqVECI3CYxUxWjuW9DuW
+b2GMBZxPS1Bu0YPpuB1Oq7Ms9TEfuf/5+XfSTKWrL5oHbUs5P3juYRVaR30d1lSr
+GDBWN7UW+9U6I475ist2rG/OhOlhPmsey5/1RHwkncTUGp18lI2t2zh5Jo3pJ5ao
+6nWNVcoQCEcSTthxOOlw/pwZnNoCx8hEmZGsXZ29zC4EE22ThUNRmFcyMR5dgl0a
+gFAYUAIFT+RyrIJt8IqRVTSy/08BKgag5wLzJgLfxDC1RO/XHOxdik4uQXoHkAK2
+8iiUMyPrKpZc+81TaRGAjvgHqkW6/UEGhjyz3PW4uxomd/LhRi3D57R0h87umzn+
+6gRXcC8FN2FfC5LjBaGwUwER3FSew02j0R7ksKBNsJbTJGdLKfj25N0Bw30kuzy9
+XpouaGXtuhfOl5v4B0E9JvWfhvzBB3++tr9L4hRX1PHsuNeSl+s27iv/DRQQFAK0
+eAQX4O7SY23xbZVu4nWaGSm7gTCS3jo+RtwTHJr/jbp08f7WHWyKiEU/Accu1KH1
+OTIGk5cib4vOzCxrV1G4mYDB8oliHGAQQbGP4aGX73Il7vAO5NXRkUvo0q0r3O6y
+yXEeFSvt3G8yLZxaN8fBXuQ/Y8niMYtD47aDLh2fNvhNb17ZgUyVGL6LlipOZsxF
+pz0VGCgpcBB72sJsZl5MpkRv8cs/2ezqTqU6Jp3Mv6QWk+qqvKKtz5+0b/iHgoAE
+O9Lbv/FZlOESNKr6/gSJjxnrmfWShslyX17RaD27tGcq0bTbV5F0W2KaiJkkDvUm
+gXxqb3Vw6u/QICOkf+009uUF9bIMGyxkM3RtbV6FN6VW/d44P46rcTafV6ta5njS
+PnkfqqbCvQsM3H8UeIS++9M2OYAsjKIMXmCeFfLTPSLmbxpVbeFb9K/9tR1blrOA
+6HwgXWUiHAAxRVlaBfiSbTg6lvIJX9xtZPd+FVEYkBJo53LVX+WEgyTIUjWU08GD
+RvM+D+xjD303WHWhBmeod+yoyrFJQ/yK3CSxJ8VJMbfwjSC4hzskti3W2MXPBHAF
+BOH2PXRmKbzRDjOqNG2s/yWAhghzDlobz2Mg6kxtd+ksbSDKZaCOhfO1JKPTEwmy
+5vjcIAt58RVV/hZMDtyWIjW9+rIKYbd89YQF6pVlbY8l/FqvDIWbzrVnWMDjwCGG
+z+xE2f6yaAHHpA1evTjktp3lIG9h/jX+oFh9c0fcfr2CFA8I9fciJEnM/xTvfjcR
+TItURG5wk754OKd5+70ai75pWO//W2p9H9oe8sU3pMZOhUrG2m0qEJuNrlW7Lzu7
+VUHjsRdPW6glMLR2XLl4f9rEo2wabCeB+MJOCIh7zpdfaUlscp2bBf4jjQ/D4JUJ
+2NJXrwRbb3AH8IUDPe936ezBNsuEzmXczrX1zfudNcu03Sww+gpVeO7jgne9NO8J
+idJoVAaOr5kg5d5ELXiXwrkn9p64N3G+GfkrIl0o+i8v9DjvOI8LB7Mgezp0N3Xw
+1PxlXr+OEGpMzL45wXiIIU5HwSFt2xjr5PgtrQdT/GCrczuuOVaqxZi7IvqcD8pm
+W+RPgbLp8M7MAwnk9xaRSGcAPN/rTIbHcUJLDxf1817UvaU+uTBSk1mjR3PJvnYC
+dJ+lmwbDdFc0wAMpYGAQok6UY1nNEmoO+ShJtPtpWS7i+JI95xXxWeGQt6nwx82Y
+hq4oehog/TOyaIwK8JMgHTsn7X0iaK//LzKTYJZann2pUDIWVjSJXfJcRk3d6xTj
+doJv31cFpL/Dq/H72YRSuxKOMuZKAlrRo8i748aUD3Ft2cNUrada7Q+Hbwug+AoE
+cidJSDidpllARdxkGda5useMKH4XTUd8QN1oEp05t0jOfzYREhHN542r38/ghEmv
+2APrc5VaTw5dPkxzqUS7RB3AdhhptVu5IX5N78lQ8H86y6BFYCNQrgs9PX4nODL6
+J4Rg5EBmWda2VZLLaToInSl5i1udVmZMoAnRAJZguT0UTrzPYOp1qs3GCDSRfjy0
+vR+5vCqHWQw60Hqs9EVJU+xbPojMOYGmSP4+Kb0H4crY6LJUlXwrZVt0l3M9liB/
+6H4uNh1K5gJIMgMiaqDJWLUew5MXr3p+roSfbOrHgI7OwbOzr1kcnQSU0lGWR/1a
+qWdtGa30BDc6MbBUdGj+faZuAOitkuNck+PfdF4OiCnsi5giSlx8UhIL/YzSSXER
+uuf1cnU9lGuS2XFz8+lrGK8YMw1Wz7rdosjWV5aCel2UfaifB18h5FmPtnUZxvbS
+lzmNBqMW1Cj8uQ7Bz+yGjZobNMXSaV14UK+bJFeOBpGEwxrnH0g9z6gwWY6X8iVD
+2MmeO4UAWJSGM2Q8cFZgez69h7C0SswUivc3OTHDQrMKjVWSIB+ynHc0KvbGv+TE
+hVdf814W8tIOGnonc45pADwu5x/deBE1V8kyDQ6UvEGfOfd1fYefU8Ml4vdKMG2w
+7PW6NE3//JfJCZDHzUAGd528Bb1PCOffvwUBmMQNOvhQpi7ZXG26R3XBToXssofh
+6ZVeqKlcZdsiMKfH9ixMWBALs0C52IIjvoS793xqfAScZs+ycAzVhEOzlqAGFI1J
+WBYvgpl8psmbqcpPapVwL/X+cz4MueftmkQKvuOSI6G9gEEKRZxnwfoHX4Zden2e
+9HydeIRxgd43AJaYpsZFY8hA4n5HGHkehs5zR35Mqaxr9XOfQeOZ5I7Y91RVc0WW
+VCVgtQ7LLBFa/LYt5WWUP0fBSvYge8jAbHVwgcypi9ii8UW471aDpSXvc4tGMMzJ
+KMvigizgGP+709SvAuD8AkTWa1kzgL77J/M77icSgztTvdIg82r8v1nqq+cc0khM
+hJYW0Na8+PLmfsSbNWdNvL4jekCjID4RS3iEstZ6sK3y/jHGsEUAkQ4gyLJb2PbU
+l3hwQDg45G3lQ+ULmK9FS90EqPBFNnPkFTyUd90aJVgShChQfwqcaDSBcVb+lU+1
+/G7amMAawn5Bd6vu1lxdfUiLgeu9xvCFF9qmPRMD3s1Y13N/n37gQPUWextSvtTu
+0PhuMpHrt4PRkEoFYzM9kQC3xqREgdHSKfrkx69tJ3b60RmPPVpQWnjXT2tGhmdz
+Vz/c8TvbNgwNmTuKMRg8dxeQbEch/D83hPLvQeuVCaLBdR1V0SpT/YlIiV17HDpe
+XAlO6nF79ZMtUXmufbwuGJovpN+EjUeIOVC639Iqx9a9coBFy4QP1/nNfrAWcRfu
+bVndIKDUFZ1RDDbD66WVOtxE6eLEw6sBFIf1NXOuzGSDJVXMl8FxZmbHL3Q0sKvt
+NvC16E3TPlXAIyVL8B1L+qyp2HQcPgJbc6U54ZB3tcEzyQj6vjouGGQPaauFeaK5
+zCLV0JGE13Pjg3YNQ9706sFK15LIbZRtM7GLpbx3UABQbc8s3qvLPPwnhWf5hmuV
+TNMBQLkU80da0QL0mWTTKMlgmuvS4nR8WDnMOC54ZWoJ5QUPg3n30h5CXOQnE5Fk
+E8qYel+kOocJHLJ7FV+JeBtuLqPDk3kfb/Rh2X/wbyMxXzqminVIcDMW2lN70sKI
+tAftsqSigTFpb0dNLNKb62SXWByi40cN5F2fi77J1y0hD0+upVRfBNsfN+FYDJ4b
+o+bolkAq4WdeZUlrfk/qBfPphxtbxDIZ7Xi2YLpbv101ZmVGBrh4mkrhF05taqZe
+n2TX7rmml/muEGUSXSmXOWn1PNe0qLkAh1kBoWpLDtCzdPicEe3WZIlFWJhAvVzt
+ehbl/kJsPI3tNvzXj/yHz71RSGbzACHU06uWDwYCS2ebCJ9HhwHgiToQGedC5A7o
+zVm6bmasjQIBvlVvkzWKZYWdNRBGlBFZKa4LPGJeWBED++zPxCUoYH4LVcSZenUF
+f0OuaDZB8x97bgJa/c4WubzhSyYLiF+h6/SSp3x6IbwicjNuI3fuBDffD41pU/lX
+MYVYsrWDec29SM1R0yy/cxZVcCaYmLG+XeAt7p3bWNaguhOGn+2jXWU8gquQXzN7
+/z0Pw/NeA9CevMAXprqy4PF45jJJq9NbWT5g5K0pbNu3eh3WudQY4MMx9iM1VHge
+JtN8FkIY7Du3uPMnE4Bfl2kfg7NNrY5q52ifZ3v/bfeTWycx+DlgaN1tpZoh+uMe
+nEAeBqEjyXvlcmRqClMCfSonPSkm6mANEvOdPwkN3eW0EFTjBy3WFQ3BJ7cCfWTy
+IZPw4YIMBuKdBLssjNun+LImfqVs/Gds9A7/W1065PCk0FZMQe7Nb8MsVWmVXT5I
+zMODdTcxVP1HUy439sw7iHa7ky4CUCGOWcFeReMZBszjRe21fMrWaGp9dbROsmZz
+lhs5zz27D0OTWoy8cyjuNmP4hrtfDEvp3YlljE4YjNBapxe3HwW72gjrMIHxbR4n
+L6yabWRcKEvF2FlbO1hLAQmu0a34n1It4VUkiCgF+KoY9MtHhtWXsYdOy8n+H4kt
+Dra/1J9P1oLIDHC6KknOkZsAaA2hdsnNt+GPSEk9wuLT89A05WS4d/kh9zDQpfXa
+qulxmJhQ5Wd9Z63flx7nLM/baUBiPfoXnuEx8pLu3N4zHPoMQvkwkQlJuYHE/WPN
+PTK0zU7TXPLTgRaSTe0cgzvO7XdQzOMJJtrS2192SaI8CLmsY0eB9/kk0xh4541j
+lgny/q6enPMKitl76VmtarX8EjdE513ivy3DzRU9Nvb3NpPiHPR2T4IK35OqNqXi
+cNnXclTLmMZu26OD1KtfF2WyqHUAhUEJtYDLo2YaW5VAAxheIX6KFI8fXn3mIjOU
+taU7XsHtUGx5pGNAKNBP9uu8AHnlX95jB3TUo5bOMCuvYOb7Wys6mnDcmu+fHT5/
+fXUb5rXvz5br1q1ELMvhI1nJ6fHRKKeqSo5Dsw0zz2L4stMF9vpQ5eFTq0PoAT5a
+9EXBQqJ5fn9/c4ZWhp8RDl6gkwxwTy6pOQcdySg8JJ3zMQHhHcD6KAhjALq3+SgM
+j8o2mUBQxH2pv0Qcb18ng90VcTO0eFpWvMYqbuqFVWaxhRFrbG40Us+TgB9MX2tt
+78CcAMlgjpXtIv7XldxJMwX5s2bjhJ5k9/OZdVmAPaNnMv5Zt/EDtxtFGFuThPpt
+F4gIDdjr/R/eqch6+oflQv3Vyfom9fL2M2xMIAoy2q/9cLtsLIeSMxpkee1q5cm3
+6QPwubR0bZ+BB26OzQm2SzdTm+gVbodgJuH6nyWVPcqQfPNHu2vpt4QJ+ObTmHUJ
+GQN+4+D1zYIl5pzysWpOMU4wwFQFwueqw/LCmcL9kWb6DiU/zijB+UjnwYwKE4y3
+CjlI9g0g4EuNjgShnm3f55IvJOAL12p5HO4eF+CPeHk76KXzm6hdHYGoW62UXEaC
+jf0XpEOHnSMXjRhtczkQ+sBiosQk/hKL6dQFCL/jKC7ciuxeBYhrBDq04izoFLPm
+a0gj84TnmudWJp3xrdQFMU9Za+NuoW3I2q5m/IJ6hGTRHciR1xF+7nlrXWdZLovX
+mKIiqLeMWIl6zl4zK+yuRtaMGclWHd2VPMeHMexSAKcJvXA0G4wrbU5Xfe1WecZX
+I12v56MAyqLZEjpz/jXs5oEqEwdw5f+fdgdp1hub4bSkN30gPiGQz85FIEKj2KbM
+Vzjx49umhv1nPX1GRPPl26W9XSXTBmjTJBGrWMHGL10/ovViaEeHNZ5Avfcdz59c
+DzENV/Dp6vEM+B9oyXB/RQh9xF3BhNrdMRES4HJexR4Xu0L270ww5BgIIZ3jkh/l
+gwKUjuh9vWr0w8uGqeGOgVswXRi9OB8qkDJJRDtjm1+AKaw6EmIS0OSuQbhnohFE
+dGNWyGYq8ZHfiwXwsN8SEBUybRvevY/UcVyPkr+rsgcMlHhYi7rXQmRkAAvm3uPE
+81kwHnyib/WRqbdz+6edbbIFOY7O+FjPDOViX7E/8k2CVo5gJwYnbxFabGL6xB8O
+BjI41CFlMiahaj9FV/id9S99vkxhezwfNDp1qasxJUH2usdF0bnF4BPR+9ZeJePi
+bLeuUM94dXiZ/BXg9jIoZIsGRJYu4BsgNjyoIFqwkf7z47aW4zcSaxEHP66mrTgo
+xwGUmkGgZjTCvpZPJw5NNygZhM0mypde0bb4ymZBTq3TMxEq6a43inj0mj5IJZtU
+9VXVmN6i92b5LuqnCFlE0/j7MsHE1qmrjMShgJs5RLPWTL+Ub93Pahku8JJ9OEQI
+IQDVjrlNnegR2AXfitUTJGvU93T+9jJo0x9AqKVkSUYWT7zIV9WdLVED3oh62iZA
+RB9V7Gkki/2ncgtniFTz6UZ8EU27n/E1P7sZFRNa9AfjF2jINQGdh4nA+8ouwbak
++pAy3LR1F7osyO4k3OxkKzV5f5k8iB/Q43CwUOWplO4MSU7DQWSjySDk6xAFE6hQ
+fdK01LL9HCfAWhLLOtBrPczI5eCAi70+p5ApC6rxizp7QkvQX0cJW5YkfVjywpvu
+0nsPUcfwvfmIcbHEqN/h9nThLF2sgorX8nbmqxCW9rbcu+7ph0qR0AsiwVckhjfH
+7X6IZXMXDBbrYXaqOtsYfBZKqk65il9vM0L1eKgTOvg36CQ6uxS9BT/f6iViyyzH
+7yKTG1So2qS6xYdpxxe57zYZyCCRbzVN+HqCpvTek1IAt1Bjm+d8wQvOPuTIyuHT
+540BLV4N2USgyDJHn7/BrxEalVXm3fnAeJ6CYAzyKYlnXe3vHueYjA/U6uN1pyps
+YPrqLprPAPw9TT9OVqGef3ptpyP1rDRK1kkesFF69KQUvA5yWaWdn0oysFf49j8x
+HhHO20jUE4otqwbLhEdJYoH/eOOyIeDaN9ctO6cnPM3tX9WxnThq3038BWCnN11D
+h4aEMcz5V/hPwp4Hb6q4pYXlJAud4XtsJUIMrpkJ5oY6UYSSzyFzYAwkPHnxeWeJ
++FCe4cT6zEdiOpG5AGM0VLbQyYujl+brdoK+qFAih8DAJWIh4c/ceZ7ffOrZN41U
+qBZtDAAbhCo9RSuqlLkxbL0skhV3//cNS50WfxZ4Jj4MQzoAq2aedS+V6wiQ2/QJ
+sb4nNu4ri9WMm3Htv6c+foMrFYgiXodpb/K6OjyaFXYEgoSRK+QYAUHWgPW80dWS
+vCTY5kCcRy0bocDAWwQwKXH+NEAMBfbBdcrmdQ/m7ixQl3HNtFpV19RgDQBYeULP
+ALGMLrzXz0vTAbwGGmHd7boIGqRqb6Q3G6pstbfbjOxRbbcCYnc+YWtUX2iTmv7G
+B+lbeglufbPchDrgEbDBcokl9UuUSpRtbVOPAsqXiQX9gq63D+iDjcD20z5u74U0
+QfXIW8qKT6OVJbjl4OcvvPm8jjAWUOuE7XGnkFcwW2WGzPE0mEDf/7DNAbfDSjN4
+WQiQXLO02FAK1w8Afn53cb8NHsdxZqQf9meNUh/wtoJ53wBZjoCqfziMzNedhw1a
+KMKYTdTuHn2NfZqMA38s/f6g5gjRukMYEQFQC0U9v1uxNxj6Tfk90/Pa5SOD/wGi
+0dmDLp7WSIfOEASwCrqbukMfXKYCmbMyXPFIYD7XBzfy4BqZUIrJT4DjBw7fDhmQ
+OmJo88AELpViHiOb8cRa02ft/D5R3/Dy6r8e17HZk5ex1fnqHTFx8OP9ZeTAyY5g
+lVam95UVJmxUN+ew0IhF/ZcxFhiSPfN3dN1AFsOqBAI3YEoVaTzL7dv1fgEdlS03
+9XEOyq1n+cmZUMVt88rzlB4s91sHm4SsomF8dQn5l2K5xwJQaxcGRrAY+LM+5JVi
+CSsXWxp/5Ihwp4cYF5xTAxg8oRTzppvb+zNpfuPStbkk3Vg9UFux6Ft9J4DA7LGA
+Zymna9ubSckS3lJwDUIhKIwJXBfjQOzbUMRfgxAeadD5VKWmYb8D9ci4H8H4WOYI
+kC/PuaYvxxknzxODHu4XSUEHNoz+6iqwG3FHE1ZtUBziZUiigq5dVcO3XLtYbtIh
+AqRe8+Gskv/oY1X39/qSuP2FruTtY+WCuPf0LMTU1/Zf5/U0SDZU8cndKOn6DaeS
+J2m1H8Z8q7vC47e8Rx4X+cwlcicWaTleHjdLOhbco0vVWlrx/BuUa+1p0ZvW7n/T
+O6qG8pytK+8gzZR1KGMU7HWEpGZ0d0TRU2ZV5TzKvmDterbXBQOE2RMCq8FFvpoQ
+jallTotlVnKyFX0E1iWXzFE9Nr9wIu0HKDr72KmPdTF98Vz17H7HzFWNEWJKof4y
+WxJhrXtln148f2tTOBrqpt6Qxlv4ZwxpatuTjKo8zCfg/jeTTljU+aytDmjYQE25
+lZoA9fayZOPp63JAfxewqtXh6uT+lyzIIyewNF0EGfo2scHGd01KFwIvUaL/h3yd
+jdZshrglua8XNOnJo/nbTdWJbfmmHOyLo4sEECro3X9jaxWbNXQm7US4vX4u3TGf
+i+qnli7sxyFx1s08KByziukdN1ePCQhxmHMFRoYem53uYH36xU8okyCFDfXgqGhX
+nesLCWtTGsLozSKibRa7z3rbXbrLnDw0c8dAVQDD10PHOUidT+aIoEv1bL752EgL
+xP3H9abC67R8SReJtHCKbgBSKiLXNoWo3j13VAXQwQh1zyS4W4nclhfu+xUB7FyX
+ENH9Nvpp2udhwXdeKQRzUjSrkoN/076mpT67Ur3vkX6/m3sSCWzaQn44rw3yoOEL
+0mGURJ+cAZAdiN/UFDzxGRUumw8zIquKzEsW8LiiGGtmQQ6anWUsZZPL2pftO2t9
+nWD661kPiP6GguySOIMVP30PcdAcRjIMqvHTYMw/c1tZZ6aEk0/82QCI/CL4CbeD
+mfqlueuQC8h86JzocLD8JE++a1pLEgXEYlaQS9N7aReNetrckUVz/NuaMgmQmJ4+
+eqxjo1fgqfpemnbN0/ytxTYzGrKHSkj9FlvB7hBhzHxe5fJzZxCN0Vu1B4w3JMx3
+r9D5q6MAOMneF8OMlpRo/TO6obVSJgtMrVQ6vIyh0ICDUNu3c5n/2bKvDlOfO4Ty
+CJkHjXI1tymRtoONDL6i009zID7cXKhdh7avjeCOO8/AEsvbDF5RKedIe5s5P8sD
+g7HDFsJ6XO9QTb/yVIfDxAewWOHHJpA5egAujVkRoEWXJ4lvUPdiONKw06lO2OD6
+6q0akLuIayWmwEt77YTLB32iDDcqNc32q5mJOay4zdFaN9o1XcNC4biQDYdOnMgk
+bTHYvy9fQ/Th8I50DYwBT7Ln5wDM9qSnOTOY2H8PC9kA2YrEMzCMCwqigJtbiC8o
+r4imA+g9DVoFXjzbftSZETYXheP2Z4fVgTie120OazD0rNS/gsh0EngTYmyzHKWT
+7uLMT4uYa0AQj68j7Y/k3ZMMMgPNuXkGpK4WKabEEAUyWCYS4dbJX2FDMNFg+Ak1
+QuKpNOIarpIEgzMY/ukObal7im+tqYGsT587Bi2jUDv0WzpKWqYE+NVlQL3LDWgv
+he/yUaRO8XsLS5eKnDBs0WRtEaZUaY8P9IcuumV46/wc3so7e44HvCpliWGymUrn
+jvpJzDfF15OfHuCW26onGWNoz9n8g9ltbZcF8fsfI3BBjB67wnFr8JHvmpljRB4s
+Fsa1yy0alaMXQOm54PLN0SGE3+eiPNlc6g1QgwpqkhAjkAdArRCB9fTtdmhgeEXf
+GKh95DyyNoMCVqjfMWyfVCVts/qSpC0yTsJ6fsl4xJiUrXsW0i15nfskkGeLtX7A
+ViDI1Wb8j3jkIaHqHX5zJPiQXyZ0KGPjJ8vmzkgNxm51kaqtWW6vOTFPTWsJeH4N
+8H2w/+Gj7dKmlcOnutBew8lmHvF1kH7fH9gvZ19E8EoRgkazW68iXkkc2Fkdym7S
+qbKB1U3zMG9em+YJcTci5v34Vw3QjivRoaZAraijCvyWyP5nPFrQHjxz2wQx/Ykw
+Bts/ZR/hDEcaZEDi/wd0/D/Rd5bdgmelNXQfgil8ZZHchwX/97rz4etVs9orYEZ0
+RIrXHpyCDd8pFb+I1ySaMFHkyxfc80mtRYYwBEJLclSFFoGVXtwXCf8JYR6odWHH
+3Mn6sTNdWPOIVT3XhoYhlwR2PdNoMSOj0DuPT8INEuniJUBX73/h1Bg+lhoNaewI
+7tO4751SPhkhnx9xR493aSHXHMzwUIXGODXZ9TKvDYxfBmzCxjXojm5QBedtHENP
+K2D2MrsJpRGq05x+7YKw5gSptuMvHrtOOCaCk8WMiAw6g97QMWLqKDyrBa5qQW+M
+t1GfPMt2IUKcBFQguBORKZin4lUqrjFSlV97QhaMJCDuL17dzmjDk8NuYy+c79yR
+mk9G+/871lmqhVvNFi7Ic17O9lFZcCBaw/0T7DwKrtKBpw4e9VpmXmVBYZnEuESu
+y3EkCyVafBu+t6RV3f3tz1i+6k17U23pCHqCqC9b7abpk2/Z5FWiG7Oeg95Y8zgg
+BkKCJyPczQLpacPRr4VhfapdXYczUBn6Fcl9Tg4ZAuPwFwjGGuwCRJxnfan2M1D8
+rR5NpsWbLYo2EZGchIMVxqmLz/JeMyF/41fRQZ8Ta/Wwr0FgTsCqPNwGb4fr/2bJ
+xV94nXTGLW3TwtbnsrjleRGsT/PbRK448KWpyhauXh0zEPhfQhM//f1u1DWaKGmx
+k5NkyQI3ypnsuBHCxNwUfUH7fjyR0SuG/ARsv0/D5j9ehLFi80N7fHFTRGwrQ4p7
+Dwd+hEn3WngoOYmiJzWxbNMIljvTTzkj8FwB4Oi9GEt2eEEK+qdJCQR/pSAwUGey
+xDP01Pl9bqberzswOrVh3V8cHWPjvrz/l+3RhyVdN+t5IGyQKewuWItGoUpV2kF5
+CKMvSzWgsxrmZHmug7jUTpEj2K+HOP3fLkSrI9FalECfesWctZt0JnNhAGxlMY8u
+Itj1J4rMnhnY2/B2nJj/XpodEpm9qC39AltEQXlQvmZ/VhAKWvgckjmQ0oLLlO3u
+h1jSGcHkyNzWpK1vSidi/EGttDgyDYkcx1S4hUwVKJqVL/k8A6UWr6B9SHSpPuYV
+RFMHy0lLt/3xaT1rx6b3q1Yw5eV16KHdKs9bsm2qFouymoHvMFJRbRbzdgBu1TPk
+WyLaPd+wchTGcaoehszRaNABmLhmvHYYnfEjmExcjGX4NJAxgfJdZ36/FBkCS0Tb
+CilxJcAt0Y/c8iOY99xmLUk5LapBWCSanipNC0bQfIdCWfrI+Bd9Q1TD0x2VA+FI
+WFYHw6tB0U0O5eq9Tnts2wTGyV2IYxbcRBYG+I1A19UY4NIybebmuy9O23oOkRZ2
+XhVi2KCibhIePgWdIoN86NjxEJcmpsvxZYFDdw9TWh5oKSDYS94hXdTMP6gByFKh
+jqLwT9x3hhq7ydU7cfIzCOWSFn9yvphCSoA/9FU0h8PKfULvEMK0T5erbdaE0pSD
+3OGwyFZnsIobYAT9a6CB0X71LStftg/puwU2CuuillgygzBz8nriRPooMYGnvkv6
+8Zu92JgwryJui3XmpKMhLs3GNGzYrxNzq0m9Y1dtOt2aO+zMUHtUnz3xXwSgboGh
+vkiMluaE+RKahVy2T8bbtkyp/4EPx2dyGOwBcrlwcgASrXuzE4obu6MrriF0CKwO
++jVZRiDLfdjT4224p4T76jY4yHT///W8vbZdYL7tr/t3rJpWBo3IPSMN3f/WG2jD
+cmGrUUrQZX7G5VaxT9rvxV6BFqD3G2Id8VqWKPzs+YtGq8hRa/Bz/3JCCY83w/ao
+a6U5lAc2Tf9Ph4GkXY76MahLX2DqeIyUWVpu6nGj5Sr8I1VdEHvP82fy7cOmtTyj
++fVO23En1CUX6fAA8nbLWZafVl8XXLKUkVEnAqj4tgWaf/AGR9AUpqJp1baLnbsR
+n6iESrl8bGun6p9pwUvJrJmMo+kMFEbr+9jsN5veEPmaACVptww/Sh6Wtob+HYQt
+R7jpIy4iIYLWoD3LtZGKjKLL3MUH7kAN1JvYgrpmGPgBhZ8CwUnPp3+qybTYFs4P
+SbAAo1HmVx08AQbwUP21caljUCKGzrzgRwaSwMRdzL7swr52zNXIdjBIRGa4oQX+
+ja6AmOc4LmYXrToAo7YV3gH8akNUA8P0i5OjcSrL+nOTAkGtRs1rzTJU6GeADq4A
+GFsRM7nGkmSsc4P2N4vwRYXtcWEE4DNNN2P8tP8CA92bdkpA9rMpmON9mXabVRsg
+Tscggpmtfv84485nMQ7B5iVgITVSyeoscSQc0lDtCpRaV0/kjepsT4+QCr3lkYCY
+L2DtR7Z+JsVKhMGqjFyOz7Vk0Ksw9/B6vczNxSPg7s7s5UFDtMTEj/iqOjnc35Yk
+EugBvonQA1sHpAxN8rngVtFSB/QMTeo1PGIZT9jN6/ATJdPU8MaXk63fci2kQho/
+yW9pTCp7gOFp8PAbjx7AIVDBQ6BnFywPtk12RArtbfHvqC//Qt3/hwDrpJ/zM0mk
+0JymxS090teCmkYtAmJH1fv1MuapztpaUuOI9dLO3eh/BLrYxFRWqHf07CTwAVZz
+SNjNG0P/RsIPMR2kjSVwYFC0NLaUYKA5PVU8wIBwb4YkTvBrD8OvGrU5AyHggP9v
+rze+eHA8gm0WiB0OTP62BmyPRYFpwmvPvfwKfkbZwTHWv7O0cQiKudQCo2+Xl8G8
+QVXhWlUy+L0v9GJ8Paub4sCZs3C4H2pDjHYAt9GNRLIgvLhiPJTP42xAWvtAMEoC
+knKxR0pmwmeKGg//pSeDAnjfkIUXBDealZSPyXm/HVKNoi+tAWZTWtcxDpNDYycF
+TERtgDWaNA36QQDt0W5ixOMwG455rYy4cBFKCb9u3Dle2/Y3w9BuPHmR95TsHTTe
+RRMn6Lge+TJmUd6UWbWPhlQ/rPEm0kVzcZDe8C6WnoxcbhVZJVCHVi8SJ+W0MZIG
+lE9y+9IgbyQl8X7aPxz2Wz3vhUdLP7H20CIgQ6gjLSH4GjfFIO97qqmRzLoKaRUD
+ZZxRWc+3a7cXeQXpLETDbKjLks0OGChSjYxBFBPcIsYqsbZxPugerNpyazvxcd6V
+dByb12M12lZcs7zXY/kJfDSk32qrlMH82R2qG+GxOql5gTuKCUpOJ+MJT6EpQF24
+Kx3KRwYoApaCLwiKWxRUSjUtONIoKu/i9sAA9wPLPvloXvospuYHyw8RBBETDlon
+G7Pf32NlaFbCqfFMvBBeVgqrLpKha8rljgZN0PTEfi/SYHcO4X1AisavDN6VwPLg
+P5EGe1frzRIz4ywgTiKU+go3GLZ0ABa2dNL2qr3zjkJzr7jKsir4v5c5wZJCXG47
+7aaZo2EHf/2P6+ahtSmjO+tPScrKM7uheJ+qD7lLwdWXfKeuyUwfUK2MCyWzKLsV
+PMGVBNRc0qgJGxxEKOtri8TH2xrR2CtA9OucsqEivx0Msld1UT+NApNY2SxkySCC
+GTgHgSen5Yi5jjMOl0WFAZbuORWTYx7pnL71g4HLTvYV9fh9Wxjod997lYlo65R1
+vxmZY2VnWLVCXeCEDhJDF5UwqAGinOvHYwQyClGuGa5lrl6aWxoevM1wXYMJtUsD
+sNqukM5qO1WRsyZn9w7Xg1UbvAIZu2ksEl+C5ZpNuBkqhKj/9X6ZRfqFNiMy1d4K
++pFhA2qQEWkhv3ATcmR5ysuACglql7tXmj07C+Ew1AKgsxMUgsPL33SnOemMr3Y9
+CzM4zeXi9BxPkNMw4Dy57ZmmG3MKiuA8tlRdboBHlsDSDw01PKjae0V1NPZ/kml+
+VZkLu1SvXjUif3+X6JzbJu7Hp1Dpw17wBa0HWCUpIiy4xY+/oahMCy3u97g+ZZTj
+Q4EGFsWp2pGq3gSlz93os6jkCsopMP0BhvX26sk0OBX3NUIBpDjzkNmV+9magwze
+WPs+TpDO6RlXzgXstMbWTFvOjN2nkilr+IM+Bj5CcctcJY4oCb2NlUnEIQdnDxnW
+Uh5gcgVwGDiUTnlwhPrUIVOs1S0f15uGBc1vrE0vKRC9c5XsHxM+Wmv822HLDE0A
+Qq/ghWka/FcxCtg2BBRouWxPcVkWbGvBb0aHE6KS8aFk/rNng/17yvKje587ZiNF
+DC9GxTZSoADFtCUAFBCcnFJP60G9Odm1GR3npfvwLJqt/uAz5TRlP7+UV1ahTw1q
+amiNAbg7ERLxNECMKpNcMf+1FR3gfG8pVHO1XdQKiye1iNM3bKeoxiVMbGrUrJ8j
+iCRS9tQ4Ua27Dv2yisqKfVGpqeDIUwx+OkxagL7aUysQhhrZqjIlVQQUs1hu/fVi
+z7SaySLI0t/7hEYW9yicv4atJTVZ+taTKtlD6Gk3hb2GJEEycv1TzEI+CWpohrnU
+rLjzSygcBihlG1Hg3VhWkJHTyc8K05EarjRZoT1nI8lUIkiX91rMCVFXOUXSV6vv
++Z21d/69uNXMw8QLGfTC/RmOiH7z5ogI3DlOfdThgTt9Kylrd9rViCRiyLCnU1uz
+RCmAZL9gSNpakqiDf9lOTvHeeQEwV90j4MS0fVQxe5q13OZ7Ma3ujP8hiIcd9uM+
+oePB0UhcWAio6QOnYmh6wn8QEIrSpVhirJzrQju0xcjZs5/oQ55ZhnUZiZQtYuGD
+5mPhXmMQFrGSijvnTfmJ+Ol7dm4A1L03BJFfJLuVcBpo8iNALK+0bnQynTU6FFoy
+dN3c6WVaSmuQQm7o6/FQuKLoVgZU91SwqiWn7yHw61eQfvKxTLdk2eFsvYrbkXf0
+JDNNuGSDlmb7W8Pv3fbyZSfjuzrcZX47aLXKUTYrTrOz5AOGYMKxt7OOl9yFbaoW
+HnkkFoqJ/XkwpteUQcovt4vfHQ8fMGceDL3rh8QGelNK8K4p6qYzKpAnan2IXRAJ
+APg77ywp/BryuYdvPvcTrfgQ6io0U6IykQ1Rb25GSozvdTZoQmab5k/GBPqG427Y
+cO0qPNq0vmC7kuDLNZBiWNyO74V7VX7dxYm0gX0qtDZxPoHfgcaJeVmPPpiYaHBC
+9Nt7+JL6gYcq2FGGeTtY/JyhBX49wie2hr5zPgM2bi0EgkoXWUxK4hHMhiDvlpBz
+ZbKp5obvfyTA6CZCkyYYL5l3zeF9eHEtMixA6WrTUNKhT4cvla+52dtA01vFeGSI
+6EKm9gFfM+QMzfYW6+u79QDWcr05lgdpj0i/7cWeOL0lOcgmzXUu0OtRTfsFgPYb
+sE91mE7uwaJLxNDVfKF1wPDVxKciSAFnf6S+EeGj1wYTz/OkIrvSiAl0r58XZHB6
+f7qcZP2yM7dZlkKtV79DIIYMOsbE0AWMKGeNvGpm1/zz8VyhOhV1KMNycfsKDrYI
+bojw7jfFDJquyT34mtLQitPHXzXmSb5EI1Jf4ytQHHBBFs5XILgIVq0yuHZWIjqg
+Y2ITHokfoVkXVTrROSLKBRmdgjpG2C1xFutDJtyUoReCHsvqBGVpClCAol1Qf82Z
+5LnV7BmYjFv+Judd2k4pRM9IDoFjVCuMtWN5259zECK/v3BySkXsBcvn5rLbK3HE
+WM3r/i32BUhwzONDMirELj3gC66f3ibp9zWSEQ/Ofd1TAuMcuOMn7hfypab4I3FQ
+8veBh7IeXTFHzH2hWMG1StIw79oZoKeDXQJUWaNh1/QDFMRrPoxZg4ofeCeJlxRT
+BW5Bhr5Gh0McvQRM2Yze4LnzrzJl0Tqnqotxofe1VtabHTQFxdNAXma6kz2sJDe3
+kMpW7UoVOGkzHx9ubXLiH8F1exIzuZxdv4m1hJ9Aj6D5FxannNiQ7fHvgWRGMBmw
+PViS3q+U5I52/HkDJuBpvbVMSaF5/1ssN9hmFUYEvqJkHqkFawSiHzIAMAoRBxCH
+v00jdQ45Oged3Rtj1bwSmLvIF4KABL98gUd6YCNLrhsi7AlLZLswiaXihOUyfUI8
+X6jHA+HT+mvQACGDa2nHXlEKeFV1ba74Tkz23tcck8+5lS8XXsaEoWIwOelYeoKf
++uxXmnugeJ4PaM06W5Sas4sxX7EqbTFl9k4NcpY889gC1qMbcwqnSkDpj2dlN7k/
+byVviuLyqtt4okSjEfCI7gVC78sX6mVMCBeoiUXz4kweuF9zmLuHiMR8trPPVaIl
+JTvXyzpyZ4zJixXulT2nKmez8TazLHvTYpB9JjfT3ShZTWxPcAg5Nv5hmV3GnTG/
+C3msIr50pwcp8s6ET95MMoJisHsvqh6dCHvF3vKmIv6ZyfBdBY0Npx7xUUejm4d/
+i0+uuMTlDkJY2yoMCeVvpuhuOAzvlRt1cv8I2DJpRn7rALo5wdZZQy4zJiZJQUKT
+ya+ylBy5gSuSwnFAzhMY7oLNS3u/OhiAkaZFiUvzqbt0OAkrvPX1Tq2AAEbWoMis
+N+oOnBjPmg1AHusqhvEvkTrNrUnow+YMnDjE4IEAZQ1bFEN8Q1zPOetdYP6/OgCN
+8o5FQKXtfzir5vX227mXn7Oaaw8QOxoJkzaw4x8WewHceXZHwe/9b/xiAKkMprH0
+ew8ysNR4qBIK1N3ZCnYRh3tq8ohOXk8myVWEPwyrVY7PRePe5WBm6DUBVWbfgKIx
+wGi1XDbejWrixbJerBtP1i+Fal5nPOGZfbb+PZQyrCG8NOCybTqyuaXYj7JmMsjN
+WOA3NSjoOo8lHwsdgz1RZlZqxP14YYH17WU9QWo/9fbaUIck+En2xh0LPUM146cw
+6BSzH9GHISO/dDBBfODdCh19UTOopZoVASvqYer5mvg4oHLAs7wDGKIZ6+qOV0Zm
+NNMiTMt6HzIRO3mVrHWF2NcPp2sgPjOSk/BZ7LTLr072mY4O4U6mHZaWW0MnEuO5
+MTA+DBtAYkHdhkrgMHqHUv+ixKtQVpyDCopuLV70MedbDh/NuW2NWyam8n2I2TDn
+gJwb81UcKzU2ANtUdL/WhLT/mIefSVv1+Qh00DLipbLvel7JF+cGMP0vdO6TAQoi
+e1a8A6B9xVuEsKG7+ujOzh+HJAUq/ktlKql7dRqQUZaBwqS75eJ5ZGHU2KOXnNud
+N8E7SOgZQJqDy2oCR/dsZNyKI2UoxxKW6baucXpIyNG6LXCw3fg/JgQYaDgyDFWz
+FJqNT6UWr/Qc62nRfbq6e9j4BlF23X/LQAA+gAhyAoVI/jFkFv4d1SXIP1e7A3Ov
+SjFbUHIRkdCzpj2CmSrcmfNezEXs2KmNh3wSOKuuzSJhxhIwRVUGm8CJPsdJIGFs
+grSkhkyDeDkv6XBxPqjRH2GPNsV9tm6KabcHDww8Iv+Aaf5aEirPkll9fkcVhJmP
+fcD+9JBZu8Mt/k8qafiqfgs346IqW67h5VEHLQPz0vkIPfTwyJx7X0GieQzSebSw
+6k2ZLrxKN9XlYHeIjdno/7zSvVvW7HYsA7PLrA4N8rxke2Qcjg2a//Rc7DGYoQ6R
+zG2PWXOuLX7HGxdIhZcVk4/nZvdB5sfQefk6fnGKpl0o4lWVkqvGzWLh3b8X3elR
+xOJMQHV0wDCfanCJEM0L0+3WzZzeRCtnN1IKV4oqtN3uBOdmvDD8VLDuaFcsSad3
+8UccgF5+EkAeZF2U3zHyFynMJJgoa1AnA+QX+CoumE/QtMVNXZm/tpBE8jdb+XUd
+iQYfgqz6dZ0D+d+YRH142my698lv/ynl4NeS4V/fbi6LF8IsRvM9HYhE198+1jsn
+3LEvsovInNBW5n5gKBtAQu+/D0CT0TO9n/PNUPm+/71M0TUoLYjWPyOSGW4GK/Fj
+5FqmUD89FQOne8fOBCi/34vShZ300n4MUbT3qLKTEUSyyKSNbswj0i60Xp/+Oxro
+h8byGTauLkAo6WBm3fK/6HMH9bcIlqb6jdZ+yu1WVwQHPdpHspLD7E2tqKggmfiJ
+DiDz1EcxwHvMsFRP1Zm3AQcSfVOIQm77liTqTunyOK+Cp9ko2d9UEkNSJ/1pNnfL
+K5pjwghaIxgRXi4WhQXqVNQcV0A+KbNMcmmD5heqLc+yXHTk2Pz5s+eU57XZQ4hf
+6p3vOLFZ307O3X85wF833bj3G7wp5ySlkIMAm26yE4+pcGpDukYzDH0FC/pV2ND2
+AcDd1Q9etg+wDT6euBQ28fouSlHrv1McyaCVRtw3V4ybNQXbT9miyb3h9RAEhmXJ
+1rO4rAIv4NLZFtCwWl0G5MJV82Voe788me/roA7nHb6/F+WCov4e4JsKfYW/2DIt
+RMsI6idqnc3aa53Wv92kC8FQHvzFloBX8bpfS8Cx549ShI31KErfOEbv+tISEkp1
++GpQtSu5OmlCbtxMjeg9OCSBA8/kfrHTjXUvO79FszjJBh3ijBOXT+zqNE362ORg
+w3Hi7kOpMu/PSfnW5czC6mmB0V06koPplZvPPacye9mVXwdubi6L2g6ELJhIJRh8
+wijWNu0QOMa0f5aSzFwqMC6artb0kkxZ1FzJ+y7DAAc766NcqkMS3MO1wkIcohXj
+bcKGloIUKpIp5xrKTWw04gELyANRpNHX7OobKa7F8syRrJlGbpfJJXfGa0SWl7hB
+LPKmHkZu4v3O2kzIfKuiYy/NGJcdm6PHB7VLyZ8sHdzymW4d1LVrCe0AUKa6b2CY
+vfVLDRYp7xkfjsUwRyEBjxbjS0ABXz+K1Obg3MFXvsKHstovez50VXY9behdPkXV
+RSlGaQT5XVyfCnnbTiUSgqcOE5qvkMgMJcf+B+u1E6GpUzOJDXpTRuejW5DYhFXs
+KOTvnLwtXMm0aS94Jpnsr8qtxmIeHIbk+2hNK1h6gS5ximEtDMLubT4G7K9UR2Zz
+BLwnsU7MUS2dN3uxstx1A1tEkVcSd8GiDbFQ7KD4hiWEWSEFIlniutQozJQPCamB
+2C2Y7dEXWWy2SWbztul692TxP2ZkojrSp3bEzUVuJwZoWC36FNQn1sS05Hb7Tsei
+B6Mh/t+Mf5/Iz/a2E3ixCXpgsJVVGZqBHFbFtWP+xZQMRjhFm2GAvpUclv6RpLTW
+Hjm2LuIP9wh0Z9Ka7pXLECBnZ7PhoeKb0PRjJ4wGUfYHLb3nooM/v4x+gmwytwWw
+TDGNXvthMNJhvYg0VvIeZzEYaKCmkW21e964Bx/0lZCEaxywK6/ZdcF0JlBwvTwE
+wudTTTrbrGM8oWCCYiGC7wxWNQgFT+Pj34D6U8GebWS3Ikv71gEjJKVv/LB/JoZF
+oeKnlPtX3MwwVnndBMJzefNe6xjQ+6o8oTcvRXOxuqL+vitvp88vvFCJZRf8yh3u
+RpwftUkxBPnca4AsTHbGdcy8ajbviVdecnbeZI3ZWnu10b+jWi9mJPAWbLKbXz7n
+saepMDEFWaWKg1Lfs7AN7jNcvXhPqFIeJu35nOWwPuxnfgN0UrYI8ZwdwC52nx7u
+01ZeUmOY1DIRPtSC+xIBdfngBN7+xrvzSYn3xOrBEaFGoorkdsZpcOrJ+8cmX4SG
+6JqmNGxuxZJb+j2Zz9RyORT6J0Lcaes0ETVebXoEU+yQA6gikPySUHv4DBMVv0V4
+UGrIn/53terz4Pez+DYNXXPU8LPiuYh9x5uCM5K6aXgXUmGuPk0ElP0jHrhQukK3
+r/Z/BXHiSHt/7mOexIDLp7uhiIE2MNeoJy0WUTWMwH7n7Kk0UzXJifJPQ2VwCYiw
+zBmpMykucF1zr0kBSQAJywpJb7IzGHpBhDiYUx/eJ9PC82xibnlBcbKy7pgr9caj
+hS7P9v2KZsa4nPrLDFIFjyO2lGL0XA6UOBHkW3g2em/XMzkUijPLU8tZwp9J5VKN
+TVK1D88ANndSfUoPFaIAemqnlUxNuYMkWNG8j+iJ5lVD5TlEe7WcsNqk+7yRIog/
+YlBktuyh69Uvv1P4iwaMYtrVqJ+FMVX22S0rTbnpLeTQWcsa8yBGQmelGJRlznNr
+UgICyDkhiiAwuU+G7IQiQPk12UF27kBmZkIp5qv8DiaXniBvTt4C+cBdXH9qZ5K/
+7/ywf50RLPpYPHCZhWR8FwOkTVOpu0xyereNH63a4oPoY5YMaIvU/HGe4PBH40BB
+1LL13y+PHAuICdOyvUrbGJFQBPlVn2brC8HHeYtazt0JFu56Cx5GE6mM3LABubG5
+hwCinhgXkB9NSSgN3N3pGX9DMklD0Lv/PSbLijZ+VMpK9Aa4CUkM8JVbRvPg/Fk7
+aicjF5HNiJwNZfAe2bWNNXxsp9Npvz4ZaH6QyWCNbHSTgMdcKDGNDyLQnjRYuz1b
+xvkKdVhwHWr/JHZdViy9cVqhoxNQPftg/LKGkb++1jIMDoAxh42IogNPfIkwOG0t
+JsC7+WhJLRxaIUESB7CY6FslskkmqLtjqD/DHCzWYNJ80WOro4soNxiPuIidW6iT
+o+KrXkMZelOowcBxj8fa1Mw+cx9ro53I8OK7A4RbYupd0++MkLQaT/5RTomAg2QK
+xCofc3IOgx7Rl8dAFfnZ30+D8ZY5rM5Q329Ky7sD812OZceEXTwibiTEuT42/DhX
+wkxkh6w19rvufdnJs2NcrVXw2uWkYQwVl/kho4JDdMUbdBI7YJoLOhfhpLLbPYok
+06Yb5HkdioJgGRVEbpnaTkZPD9YP64pX249HazmSdZsknSFgU9kyp/yy4G6n5UEh
+IGrPYh/9MCc+k741r04oaVGbE82NgorEJjwT0KelKseOzI5qltNQrdFu6QoGMDbg
+08g1PqeUISa699tYVPhegvxRFYzpudlc5dEApZ8YSb40b36XaivCBGBXHfIWrwLX
+HdaxAnmjO+yP2Law65N97l56JmLYfzqkU97+WX2Dy4qc/1eFrqrW6zBtInofTVuF
+/7PcadBnvMxc2IMHMMNf16NNlaVJ+pm+bNVHSFfJCOyObA2Tcpv3luDKlKjlJ3K0
+85hQmU1JIfdQzrBfAcCK1FqPYy4h1LgDR/IRfY2Eobf0t/VXNbGdkvS5jen1i66x
+Cd2caEEZ0Kq6WhzTpj6K0tyd3Tav1UBQbXOi2Cq/fvh/SuO4IqCBkXjIrDTLVBXC
+AHoDJHIsWHkhYqVC18Dnactaw7aYOj9QhMjDidQOTnrV7M42VCsYSOcEUERh1OZA
+aPqrgFP6h7fhydXMKO+Qr/dub+hY3J4mRgBWkWRHIOw2Pqn0OoJoZ+1Bz7kwMYMI
+mXwpvV1u2Fijvu0Z5SqmrKGanDwFsdHyq1yJfjBQaxw21jG72+D5ErwzdgDdbAlT
+0HrzejopzT2rIgpua9V32wTjphamrhVEjNbpqnkUxoHJRIfNF9Ip6IV5DaPZdahp
+Ad6/2TnQdduDKWWnEMZzU7UkWCHZwPmKU3zHrD+98eBs417Evm/ZHuNZ4HzPV9c4
+ZyYEEGUKpENfqSfDOUbpbJK5QL4ZLmuSDjPDpBxqLDveqTZP0EQUdGLEx0M4Jc9L
+uDY48WblD2rn7QRAvj+Be0Zed7nY9FgY0qrc8Fz0g+WWnUAwTMgz5pe7jUiicIBo
+12Pu59s1x7vCXzc8JAQSc+WGcm1rttokAoApeJehO/Yjk58T3jJuVGMvjG8o8XtM
+KGdWKuc4GgiLFdq/x8Q3ncmYwLGa4KXVYrA24D+th/4nmUAS6lTakzfNRg862Dti
+sfO37lAUo1aWJyfDFpW8nvUcZly+zlJu8KC7nucXXanpVjOhEMJiaXcohF6zHRPP
+qpP+xD+HPBIYskdVCdsjAl8BkkXSwOTaeyCuR77eFqDvhKhnaMtSqhDxNlph/zkg
+gS+620tv9LubE9vvYSXZVT6XFowKhd4cgco7/HewlpMPsAstLXS19d5UDnya0lKV
+VARZmHv3FLPPF9TDj3zuobR8sCdjGTWmYn9S35GuGFf0mV8qkwsM3AnNeJX/tO9b
+ZqTgK8FOdvc62AI4KvNnZ0La53piYkINSe+xKQYURMj9GRyLe9Okdku4WcQVdoVc
+AAYTG6HlFxfZ+ZnxdIyMdk7vEE76rK3hYxiPkoCSQzHOwD+cx0tfgiaB7sh6ftY8
+tr0aCe2yE5BWWtEzI75ioLT6vLqwbAr71tTQy1g0wgP5x7EdIkMn47cdPoOkUf03
+4a1dTuSJ57lJjPPsf0RXv1tE/iO03Gkv0VpeAvEPLMn/ObfzJuPav4yL5sMMgCpd
+ZujMa1r11N4Rfnf5XePEPoD5pLt6OjCFMuy56q8UJZYAb96p1VG+dkmHkCwm9/+P
+mD/NvM2MAJmCnXxtoOkZjN8aifhY4/TLev0ZOLxxXVPP4rqCYjxr2ybCV/dbcYTf
+jA4TsNvEgEuKJHzHFoO2gxWwyjjik4x+zVWAmb/qIGepbwGYOA53UVWPvlzgVNjW
+Of2CGHYbiiQUxQIAgeAawDYre73tQGbT6vzcjEWXpMOfpMguUNiYa11zNCMxjseJ
+YeQsdK5d5ab66BIEu31Bc+vPwr2kg5FIH1r6b+H0lM1x5xRGpXORZcKKDsUlaEoF
+XYWKU1bA9/stcZZ6Xx6jLoRkODemb1d4lynts9tSiEBNTJIWv9Pt4vxCgnjjMV+5
+EG52CxQKmii3C3D7H1JEtwhkgFhVWVFC+qhWWRgp+fwYX5+LhYC1Trq3XaOGpwnZ
+0q3eIXTViisIrPbe+HtFHgJau7YQ5aWQbZnitBVzijp2yAqUfMSZJNltJXQIp6tx
+YsVXXOxS+d1yOIKjoSkm8vcfsIT7dVph3prtmfXVKl9RJo8EAwMygh9KBI9flqS5
+5KmDD06zPz7vxtbZyo53evxqvRjycgyNR4Tz2119Z2W9bqrtpuvokBcOu3MIIsv7
+nhbL7FlzlqfyHG88Pd30qKBIqd5sOqJvxEoRyxCd5QHyxlv3+sE/kBd8iO7P0wVi
+bqnqtFrQUpNK5QC+V1/jFm2KpOrR6IXN/b3sz/SZI3oo2+2ake1Nc56IOrbnAKih
+haIy3TWEdnYrCY4LgeG+GpqoJ2hff0091fW9oVXf8zTgq5S2chlqqVkt195z7Z7l
+bDB3pjsbmbs07KPFHi0p/lALKDfqWuZSJOPQBNGNrYXNqa5yZ4bVqUfptnayQxbB
+uyEEsn1tN6oibcVFFJTBnjI/6J2+H3eABtnJexpRScOEgejBRj4pX+6shW4hDMCQ
+Ny7wy4Uc1IjE/POvAMZ7MhMwWTQfgZLqi8ywF659GOB8sxYF7I4IfzTfjYXQfFXw
+mkaodS3K05RXVlKyvdAtTFSA6C8WnwaEemJeKt8G7GEDOqy3hsuU1cQkudO1ga8l
+9Z+Do8n2swEzWL1oQUaauPGdtPn1Q5mu1Zv90RIILKs4Xy8jf+FGlVWXCuWBPphQ
+CF9+ViGAz4RxH+PqowFcSYzDyrJO+eMe3B4fzpme/CxxS6G0rjAdWP8r5xrP417+
+z/G0Jm4tL4stFeOlut/PFM95XQ6e45bJtm9VNxKVXh8loivI0AH8LdQ+VcDE/GlF
+DZ8yqWV6qP6dZ4XFfNbblvFeGbH6YBLAqlV/ymX/eat+35jFuSUO+9VyQfxukqL3
+vlm2wl2FCvS9qubtEPMBcNtvc2robA4OFWHQrBYn5OZhE/g0Sn0e5CFzzAUYON3s
+N4jWrLBoRTsOTaz26Mb8CiTtId23FjGrU8jZeBMB+Tqsidq231r1aOpAAsa/brcp
+VvkJPTu1rco2cFY61Fe/Euig6ZFr/FdJ7CKxwTx8Y7i1aSZ2CeuDUp3PYajBN2GB
+w/YnUKzoVjO3mCxpMfjIOiInjJ+O5BA7ra97xuX/c6g68WYxTCcPPlusJ4mo7su8
+opV70s/VEgCfqP+0cn1AdeYkt79Xcbcvn7Q8IjiBwOdsUA3Lw6RLNdPAE6rgJMcd
+qqS6+zWwljRCkgxyxJjWmrOIVCK7EI/Z3r77kcX5vrEsOXTVhZxrmSPaiwSf3gKq
+zcaA4Xqq5s+tEsxZWANdqFLJzrohnWxUXkLdV2pAH8+jVk/hdY3XrBP+rrfpgB19
+0EYe8yFw16Z0Tg6IyQrf782Dj63sIdT24zNDCM5ks6thkPslPQbJP/JjgKgsOWur
+keZEhLumEe4hSEYsU+/VfVaCy10AepXtrHTHxM5jlxfCDtcg9936KSawUYfb72x9
+dIKUO3jwxuYtlVZZLP+loX55BWi8BdE5A3NYSVFLwrWTaZAinQp0iD76+AB9bkgk
+rZ2BOHJ4e2vvLAk5wwNdTuKJ2Hb83oXY9kl3uVOp9gxvosGu3jcR7vU2cEeV8kKk
++wSJ6SAPf4nvCb2mvF66ya4M12z5Dy0sbFTzZh8/ABa8+EQh8esnOewXnGk53mVF
+kp1ObP7eC8EpMK/YqpNgf0/625OhaH1phptvQEJU0KBfzoaBlMJN0b6QNqrzbdiO
+3ZivoOPyUoxHyWTnle14PqfgS1aIkDyYO/tnrBZ87NmY6rNOCaKYe09U+VsJk5b8
+R91b3ojWQmuCh1c8rD/oNFE+gsWh2lDeqnjLSQ/Hlyc8EhbWcr7yGl8k8eai4Qrl
+HXO15NkntgukO4ahPNbWaPJ6JvTRsx/RFRgk7eXRTTnc1l/+bCgMmp5UYMz4UVEL
+GGxH17QJ19snUeqCX24eKFfgTG51sabxlk3qnCrS2ugnQ/BwkG0fmDI51YJbzFq0
+p9r7GQvOne6licjnpdN1b6i3LYfnLdehV7ENSqUGHHVZxrE0SbvtHQAA2sfUBofl
+zOuETXIywYlikGm5eTZDQreOxyZUFwpZQNLs8sNw1THAk9WSgx/Jb+8eAXQlelWE
+ySiuM2dNa7aQkRjTCbJzDC3vMpsUwdPBI096ArAGHzHhETIHEUYvarXXqMwiasPY
+1kNjxiq3IeTp+EYMAdQPMlnySmuHQKwh3Ua8T3Ai0vfQyTBEaIf/xrymxihiLrKs
+cslVGsJLSIYq0PkfVoYUTAHFmWV+jRFpCICUjl09WZLZk5JjP/pAufD/kCUCYLBl
+rrIHvNF24r8JHhhCLstW6Fc85qvK6teDO1QrleHxTNyKdVOLffMNEEqwgY6azjhw
+G5UNY4JeLZ54AWE7+TEFhhwm5P+cAumD/CTpFuxahvROmQzQtQ+OBpoHrbSC6uSx
+7s4wNr8rtqar0D/NOBDWDarM9s02PrSuxR8CGNsXwNeqV1J35xuCVX6Ku4SoRdC+
+nFqwZbxtlvTiEaovdEpcN9HyQWtU53rtGH0ZtOvtvdY+RY/p5YGwqhiX0Y10/F6z
+XKbPMFeiOSrVwfqQaZZKx8uQFdA5ZwnCWacg3oaw/Se6lvzOK9Hox54fnOyiETOo
+exnpX3iegdOZ609756hk+RNOuv46EtFPzGqQoDcDx8X/euM8FbacXPj+uyBKHuUg
+My74UeSNPC49F0hbPHMSTZY7gWx2IxqFZnfPhRVv6FHXw0EDgjtHiMKa1I9eLtfY
+u6SnkLaAg3pcyw7CcgutRi2KuGdNLuwataXWtrg8WVeHYtDbxGahIPEUjEh9XpYb
+wL6+ESHkHmoD0kwbHGNIjSxYLFHes40nHJ6+tnnNQxxCG3Xxr32Dps5IrZ8GiYlD
+ZLlg6bBGwMjscWZO76Xv8kslNOsh5Oknw6fNvvsh/rW2HZrUd/G9V6KW+DgDxhBG
+IIJayDwHG6dAYMeXozppZMTiggUYAJKTijIecEyXAz+a5W6g26/o0lC7D7TA90Rc
+gjfnHqDz9qdQRjhoCUrhCRSvv09wmcRFTj7pYMs1W9zRZFMhusNW31VB8HaS6/0b
++pHeIBdj7yuFccrEk86b0w/5JJpMQJdzPskk1Wlnm2Bubz89BKFPgCYrprta3x8H
+pLt/8e9At0592aphyC/2mEQ9jN1wjrx7hXOp3nznBe3qgZXU2kpPNlixTEu+nHiu
+DGwA5nHD3RbCnUM1SUSox7Ns3pp2VXqu/7C15P53C0QNc4EQMNEFgF1Ga17mQbKD
+3SEgtUlsNGXjP6o2fmF/bcXbVROB3NWd3ODewns3llSSynYe/hmRSFuuicqL837p
+JnwRCQ/hlyvFyBZY2aN6H1cVFvdqYP+79vU4vXj0tSIDRrkrtlhTXiUzyvkaomk7
+PeZjjInWMjZkPHZDEAbT2iPPX8x66acFWQKlqNzB/du8wn0iaGbAcsyKHZtVU+1z
+n57XrUTqANmwzIkLsBH1pHWAqlYFVxlBgh8tszve9WTG247/8un7OrS16Z0MR+Re
+1P1J+UfqphJOGwZ5nh5SzX0NtmgFx9RGIjyKIbXKeKN6/p4vX4URC+8x9hBPPvMC
+2j+gmZssoK3/sa1CKmfLcsu8l+Nk4dCg+0OjfOUJFa/HHwCKJLYCiOVm+cQ0tgPt
+oY9u6yyoBL20PAM/+G2amHR5bA13egs+c9vgkCNqKRShR+UFBKAe6UCrvSvX5d2l
+LL+1tYwjdtpJWoM2dtwwV8NbtxAy2cMarMou5HMPhxWtFmbGcSZv3WaXS/7qsmzN
+Z9wuZa4mSJfIX2m+sDQ0q7zkLfCHwAtoubS4aUfkW+9Zd8c0MMwMgSGUvVzF7nMM
+htZtmhPkVsGnI+HpgfzMjdoPqESx4IPYL7UP3IbZJjmX+fj2O3Qcul1LEYglxyvk
+FcWQZUqKzGkE2O1rFVud0k9TdbNUcJ0lv38nvhxw7w0KFYpliIfTmPJVNIfZ+i/E
+9HCsbaKg+J9BwfgsN+g8tS1yRMNfkIkhEKUxr74dFQBtKebBX4EEq8SQNRY5O61P
+ucROFZKeNUGVUDHw0lf0ECwQgxNMgvd1vVpwQaCOVuBW1rJZiuU3q/YHq1JnhsgZ
+xNGiOshvVCbwTNj1sjkynXJuV+SryAShRCq6C2AAzotp1M5MC1Fd3soAOv/UPK+U
+0dTowQ5nS7gCSrgMCOIA9LK/rcf7unz70aU0gO8NYe0qEYSA7dlDrs6LCABbaF8R
+nc+8extSWOCZYKFC64/0fiFpMc5z8g8asSNNfzvaoXHn0FMb2zAF+zsc0PqFTR6/
+LUqfOBQc9nx8zNXldrCaAppmgSdKFfMnMZxIXGV+OLKJlKhCMUX/6dkOWoE3Jtc9
+frFSMjtRSCNhNe2MAJUGpNk2J9Pv9lJ2+redR1mpBw4J9HcUTgRT9Lrhzx1DJoFD
+yyaWWL/f43YFgXNGpZ0IftNCFAXMlduEC11za8baXrh2cmCdz0Vt398HT27bg7Gi
+bQ1ZLa58yGRMgfzfD2ihB9yBsCeMBnnKhIRLqaD8hpxF0JW9o9yIUd0cv2bSdQZT
+UG3yxg3Cj1AiiiyjPOYVaXLLp/Fri937CqEVbYT8kabD4h0pYrz+qCRRRxEOAtb1
+M3GqNsnugm6PopTPgmdkRH4SKLdFQHFnhm2FnqVT1THaL2jDwD71SqfFhsPma2g8
+Wf4NYyWPFf8V2qDb/J0GgdeMKYtNgVJQlv3fMopByGplj+1WmWMsT6RIjTjl60/R
+hFhHvKz248crp/YvYmJtO18Poi7Jr4v+VeDBSdlSpR5cr1SbtULR5xGk5xmhiLxg
+hFFSIqxvhW3G7uPNAaNTHKCW+4xpCny505/R37Svztn0MFT846QDxQPj8ha1R/HD
+xP/ac9vBAprMBXuqrc0gWDFIDHME8KqKyKf+/LfQ5dTKEefk+zz5cPbxmgY4WWBt
+/99gpLQ0n9dO5veH23IuSoHH7ta0GTkBUFeusBqTBFQWbS/xr4AJQzmN+5E02JFj
+SfJ9WfX+YhARGEDNwq9w0oOHaI0Ju9feaYw8FIsBpqVP6RaJClkDCnthBkTuaAVb
+4D14h0Ym7YEYtnDn1iwY3z9slrvKKwD4gBalJruxLdNkMoeM8u9nzjt8xQ1HEr9o
+WZAQpCbWAfZNdK0XIbGBj5lAm/h1B2fcU8ukCrcl+N+Wpk/r+9jfCbtY0eIPIuib
+cIiYhIRD6K2zzpxWgV8dYF6BWxqlBbzBI0q2oBu1TkAQl3DoN+NPKLWhvaiK+ejR
+Le9GJ53YqdKoGNOL7L5+wU4uWce+GO/GdZMLoXawR8ygTIM68y6Yw+3+lls/sI1O
+YcAFrRBlJtRDXmzjxuZCZY02PfXRBR6/KBFSHfYoODMs/DrlbYrOSKuxDreSjieQ
+ogXG59ADMcARQYhFbPoVsyysYvs+3rJP4lBC7uFVCGvmPdYMnLjdiEU1QdGhl6/5
+FBsaZSYZZTGT/wge9KlKgE+lv6WuUgh1Hew+yv1ndUpGLGHdsAs/lqHevJLAU9MJ
+JpfZrESAzXvguLgauZYqYipzwQ7mcFRVVbUBE+7Bnb65De5GpWR3DfUPnI9MY16X
+4f5vxnNP/0OW70D93HEcKC4mq7uJ15KTZTYoA44yXf9aBmXV3wNsgiLhuHc5woSD
+GlCTdfCwnjHJd+IP3EfHurnRC/U3IBG1EXd8eZ3YiIVlgNPF2RE4IKEfQaYrJtSX
+8UCYbwa0s7K3tMaKOyCYSOevfZmFb0ghs/By6DyH5r9j1rLZlyFG7AJCCk2nOxKk
+ONR4NfiCgTEueVRuEDl7TgSY2SHfp8BwNB20htOw/u3Qy6Y5JdQT7u9u/gF/iR95
+GiZ7HjSZ196igQYXrstRcidsIJWUF0x6XcKfALFZudG6pisMQVafs4zeirQ/Gldo
+1cu0FdG9Fd9X0dgV4Pmy7FaEOvfFVlAqEPQcy/sYhpj5ygeqEebK2wjmTQNxQNEb
+qyGIVHaJIrKxstByPMiAiDWj0atLgLWtEF3UIIjBaFCZHoHqrXMWZa5VmsVsEBia
+HsfXunTHJgojJGL4XiCvkU9rmjLhKVHbxe4tsAYbWktCa8v4EfHv3NeXkpcyUgcA
+6h0j2WJjUEAEzX2IqOQTbz5UMzAqARB33HvacatY4U4lk98vyuIxVqkLDaIMS4Ns
+icind6OVfdmElyArq3c99PaKbYxy6Bdftw+M7IJk0fim3ANRsHKV23cHqkSf57lB
+F6BZzqaAOu/t8bNNFj1uQnIaq4yVXGk86VnaZ0Y/v1aDVvlYUUe80C2Gd179etCb
+nBhr+6XXksUTjIVSRIS18l5rbgcHYrWfxX2PSEEVz2agzePwA86XfJK8PxvBbMY5
+M5kNOTWgl+Ypdx4Ys0niJ2kv/KON6xZPA9v+bxjrJd5Lazk/ufB1wvi8A3NbosH6
+Yb7+KUUeaBPVVfz4UURl7q7xS9eLZjHNpAkNNZOSFWnGEDX3Pgfgc8kU05zlfIPY
+Sa9QVT7sD8wBtYFOThgFsExvBnP1e51H3bc4G8K/h2IetjFCB8tJQGTRNGV+gfe5
+KWNR9GgBgLkvK0kBROKu6Y2p+H5u3tmLH0g0rAjEUCrh1z7FkREelHFj2yMDG4+/
+oLEKfhzVhQPssHcLrCIexVwjlHGpvSTdOXfxEijl9uGMqWtTMQ9Ytu/X25QFfRPx
+s5j3+Hb2torwiTXm6D/O1xMfFl2vwLp1mM0p9h0LWyDF4IcRxobAa/6RItTOIcdT
+30fYRYY9DDh3elFlPqG41T96CbfpBjez6TPJStUOzWfValB2TEf5gM25W9Z5wLhj
+Q200wGeKPQaTZ75JlzCNNexr0v+4CbV3MpwRXKUqfiJQXfOGlVFhWbf6D2GFChOO
+fPWnWG3ZDvRRzX6aXsKHo2ycVrTAMdElOSDIKorJ0Af3amGq15dDt/NwUsjdzQY+
+pQ5e+Eg8uXQny2UB6sv9LYlYBtnFWzhFtjWaIEVb29oM+xQX7tXsoKJe4Wetq15L
+cWvG5euAftzBMgwiHzIwl3+XhsL2tREVTsEGHdSXCVynO1ZWoJi3dV8dkIZH9i6Z
+VSwcj3kf1NelH0o3GCM2judj6nRCC5infgyUDDe2CzeTwymqTnTqOx9AgXXDv872
+UAU0AKEXYYGHCVy3wdMGNPgt1AveC/YYZXOtyBF4pj+6QDxNyu1bWjP98MOHnl14
+avV1h0iBlqxnZP6uhQPsC1YdB9x8f9AYr9Yb4KcUnq5TXd4mANIsWF38uhKce5Vt
+2oeAZk06y9XTsrDrHsoU+/n7+0lTZ3xcbWPA3POM+l9nJRU+3nSCJBn+Txvid15S
+wYmSfmfj1gUEqskB8GzjvWD/Oeqwrl43DknSp0n80jS5Insz8JjMwaWqyPoaEWHz
+IbLIFnrHOw+S48DZJIPBQuew1ONejc5nq3wdCM16sW84g93CocZLZILWhfzxibPg
+mTjdhbGQ9atRDIs0fyEvSrD9V6yK3OL5bJfAdR5R3yuP6yV6G/dHpGQ0RvDt3ab1
+I1XM/Ls5RP+sanoaEPY6KP53Ps1GFOt9mGY2LWyvR7z+7nZte5CoAxfCoY/542Kf
+um+uhohdtvnbSipqxa/6CD5ywBwm3ZEtnhXG2sP9hnsZbYF/NnlLhENwA8wMGPZY
+PnXnQyjuRKzsAD5Jzy/l5JwbgmrYlxMGdQRPGiA39cBDqq6845FpOJSysmN+tA0i
+8CoyXHVUV6mejLViMcjMmOzVltwgmysoBt11okwTY01hEPpfA/4YdUmLC59S4u8C
+Vm3OviyfdVR0f0WnE/lhPDTeWQewaAsLWatYy0hEjBaPdX9OUG+jaOfxEK/mktLL
+Pwf4wckWO0BZ3lAroYLm9AavlwMWjrF2OTrpuhk15AVbFYA3OBBzq3kBGke+qdxe
+MxZi7wMeDleYS2E1tHAXzcETNy3HX5QEutHTMch80XVNmLU3dzLzrW5xxdbNSU3o
+Zcb4EAQHj9N3FBkIlWnbGK8PcW64ISmgA0boHdnduONXBkueZQYXSqwvGHMTH1Vp
+XElstVUy7wqJx6tPoXln95EFYjCiWfVi9pu0QTSKxCTwNGM3xR7kPOgjQCT3OJBK
+G2BTWdRb9FdQUyecTdbw7eV+Ap9OhvLHau7EMXyvpTt5J/lCiRAfrH7JkMYY4Hkp
+QRjB3097GwTLfSkyVzL9n1ElrI/bDIGp4+purKJf8JliQZU+zn0nXjeBsyVKOG+e
+r8UL6BzBjw0O7mVlLd3mvZcjncIAALDMQi66pQb2Jhp7VMttePABWStXWbJdX/Gr
+c1a0nVQTZqibM3aYssnD9T8DhgUBVUSDfZIETysxQ0/W5njv/qrzhokWi3y+LVod
+NgEd7NMS7TkoO1/BQQCci2i4wSBZfzK4PZES58hgdAW3A8SSd/rgNrBks9ybFlYn
+vBMAg0SUJqYaPyaOT4UW2D7mgViX7ZZLqFV7mPswlMRWaed4zQTCeuK4LGfmXx/3
+urW9l454zTHZyx8RQ9foQR4Git463ABVqEdVkqXnC4s5f4jN2VUkBP0CB7kSLwEF
+trj+fxT7YlCrqKi4tVi9/h1dnllFr9dRB4EeGDTz/u+CIkCxOTiWpL3XyolJ1Btj
+tNl9/0TSnk1z+QDvEu2UORU7DdM8iIFqHILzZ7tVl5q3Pc25eiEsWa9IshvJVczx
+rlgURaEcRs0AjooO9IQnEvAKo4r1083QcP+WFMz6UVs6NC2S/jubXk20jSy1TW6k
+rkL3/yD2NfutS/TETi1iNPaVrpsyaNar0yYzDKhSBK2IEFleJ82TA/Ua/tAUhiGi
+0M9eLFwYPrWp+ZgNYwj3ccwlbTuancdbWvrxnKCZaUkcEVOFPPy+ip56Nx1IDkX6
+rFg/Hb7L/tYz96nrgllGtSscmstAhuGyMtcdo5b7oYxXRZA9jU0x9O59LRhsIp5w
+BFyx8pf9HGK4Sczn0yT1v2/OLvxW177YcmCbRGaIY5borersZRHL9OtQCTl2gdAv
+NujOokWL7UmMhFd3XkoKrM8VcA8B59+0HCxSmEukrGJWMdf1RkmyPmjyfgMlcEBi
+zBoOYVDwfKpWSkijP/2Rh3NclJSJA8DVsr2iE5qfmUaEP7pAi80d9S9FamQqSFhK
+UYp3FhKrtlB6RJkmFyzw+WrgZRbyL7WXjdRoBLKrsrEW1hf2zF/hSAFEVIboYj2N
+MhgHuN25MwEA9oEGerE7s9DYyoFKHSsKUk2R2/BFyqnWyRMdkguXiVVzDiLdxLjJ
+2WlNblX/HOsDSmbKzIM+Ezi+yrY/5zDy+ZJrRXReqP8ELjmKaeloPQV3C7020UeD
+QGG+f41IXNpuCSyehc5owiEkgJsigSOFogQgKP4I63/xRcpDsjltz9KJEvdO9F/4
+FFv1d5TdC2CA5iCZY9/RH8B7YyYBKzBd8TDJZZDrhXaPn/8fNGFByOoadlfCoX8g
+2+HRo9dipCj5XOLK7qvAP8Vz77LMoV9078X/Q66+FljyM9szjZ0yhuRcdZjpc1Y1
+ZqT5/ee0cBvMaKrwKAiFWpNQhEV+GXRd2djiNcp3CHfEIeGmTpqJCJQi8jdpeoWc
+gqcT9JYuzhVoGLT4UB/igjA47BZDChRz+Ga8pBlCxzpquuUQp/xVxv2wPR7HPrSQ
+TYuy5GXGeIpglwUaFX+Xw1l0l76hOSNAVY2/gWGCC5naJhuMcD8Vq/9lF32fikhL
+VwFwQAwPFQ2tj4tDCAd7hlQCnQ+A1NBj75whWCPmhoax5UMTFH/LmKbCSdlUsJ0L
+d4GAS7bPVmlKdndZEr1dSfiOjgDRmhbdCZ2Z7Ml95MS+EGdLctsNkeOhyqdzOguP
+R8camPVAL7+NKKWQChqA04bLZCXFC+Pk5vuDlYx4CbKjjkymGopOO9P57OklPtCH
+J0bwmCQJquvONlPbp53/2qrU7xMBo/iEuH2nkix2XYb6Ui6SgZKEja0kgOcQ0/8v
+LIyyTebfoeKZH5hS9TYlz0Ez+Vvx2NPB1yTDwZ7aRLgiHCr5DPN/e+vHWvM/bgWv
+51kXy/Q7BSSCFL6Or1GYYfdK62uCXDSHDU6TADLFomM5Ic4TvmD3bBB0bpmwsmLd
+0mSIi8OVQlbNXipFdbXI8avMw+LfNNQlo+W182CmKrMBEx6HLkBQCqqznCWZl9z9
+wfGY9nwARJqO/3gtmLs7aOZ/Px33TKDZjYQT34cKrE7TbdDrgdJj9eHly3M6rvEZ
+RruCtgQnT1g80RJpqOxMrGEFHhbLvvh0zf6X7ZPTf9pJIKqNprJ+DnkkyL+ywhb9
+jEygqB+tMPOK7GbsLz0Bip1D0Dt86a3/wPNI7unZwYtWF7q/xOUc7U/7F51IllGd
+5HN1bppL6JA8jMatlM56OBIkNU+aBnPbpmNye1F5suvDIKrwjFNs5CSdwrX0B0Dw
+fpVALNbbLrZNzKbckMCCoXkJPjmAfXB+NrZp/Mshw6Qv9WUk7QqM/3LHE+4lat5J
+o5bjnnVhz5Ot2tGaWIwaoo6n5Z54rZ/C9w4GWdo6ND//qv3uUcrFFHAeKcsYOXYh
+NNzF9RzPoO5eqgELM4C7zLgveREA6Omm2r5ScwsP8HSYgOki/S1m+ztW10/E98dy
+fCcIJES7jIB998U5JK5FZ30WQe9kDE8ug6OCV0tonbaPt6M/QHUP6/mnB6rLUFof
+d0eDpWivkVdVgSskM/FRiBBQcZZ0OOQ59BSwg0ZAgQy0Fej4T0dgAZOQOApomYPk
+3GcSHroDKnLih7FiOGeuXhxo8e5rf4oaPUTVhgbaRyRVKKI4ofFFJp29QsXLfrrK
+DoM917D4DtdJpb6fJazHk8UyzR/5ZBo2FS1YdYNAQo2we3Woc7IcDefNtRkaWt1h
+M9CbM1O3tD/yvwA91nfPabCNnSmrl6FhWOsKplwYAyo5+pMEtBMj5oWBlqm16fcE
+IZNKlBovr3euGBMYyZGIqzDmRaBHsfxxDgpMy6EqOIHza6fuwlr+WwBQGM49BRkN
+OQqQdWYUVK47BqZxKq6SI2C47/kGj/YZ5ZOpNDiuMJduJBXD+igKHIiTKXfJxI6H
+x55I6feJMWLK4kjh4M+gciDNXk2wqje6pr7ricruwsOZ+aoRBI51qO/gPxXYoZ7w
+4/YeCYifrSCiaK5uGvTpDtMCzty224Udwf6bgXFMRODIZD9JkLoMBlREEaLqPD0M
+Oy7GkdrQ/f8YK6fpA7Z6y2dbyHju2F4UsC92cToY3Pb//nIaqOk6bmZTE7ZQbKww
+CEzs34YVYQYnLzAtDmayeYUyIAfpSCQopHLYmhsQ1NJgizTtIHw7G0UbbI+K0aVT
+qRdTtYkCWFtgzR2fxWiXk0UyBkXtq5vI2gxYNPO5GFMChrMz0rS1rfi8f39hku8w
+To5wHZjl6D/ah5EjvwK/4dn+ijlt5B4VhYOGqay3XODFpwjzmFoy3zFqI0ZPyuWL
+XAtB6qEixamOvF6Yu2nv3CSyn/Y1dmijYq73So0vIpq+SfRc2MIUrKkECGi5IRki
+D4TV7csC+pcYzeKrVQFCn4X3It2UA5GyDA9B09JmKBesy51HzHwVO7gctvuMa3j5
+ckTEYsRreDNOGDB+yHDPAV7LTn2Y1Nmm8i17dC/WcAWK7BMhM1QSeNCbNzVRrxJt
+ByRzmx/pQRIuHqwT1ki5kKStrVrIFYQWkIZJzCbgcOxd5FwhRzRNXF8RKCVwiaKu
+JgOzv6Hk3kiJ9RBd/AcnnHakxE+JF2YsV9qn+B/sWgq7EpQNUMtluhDYk5S61ITr
+9rAl9LFlH6XXK3BKtBrR2aKDhHAMEZH4LkyNbitM5ALHWY1vPf9+pTsF+PwYsd7F
+q8SyaJMZqGCUQEF1hGzRyGiTI+BXVUZNTWl/ON62YHU2H1fYXKvwsIyaEUEn4ArZ
+ZosEGybijcIE3PhRg2aooNK6w/ltjL7M/ls0VUASTFqwmpHrvnGsY576b+rOiJic
+8G9troDfE7tdVzBAxvO9xHA5IwyWLp3SWfcYjyulI4Zzlf0bpkASc/aZo1zwNbeW
+RYYehO1PlMwLsdID/E2kvpCBHgC3Pln+2xtBsg56poG2aBePPmGQ3xKs4AzT3jAq
+3fA2hFBYtewyZj8Ay1Mf1P6hMzciB+pnCREQynVtcNIDR2BwinRF0Lq0FKyKhgPJ
+x93n31kbuDsqa15zynKmwCxqe2Cobg2u1zxNEiWPgMrmkXRpKh9nnKB5aILCyVcu
+ZvO7e1mRFl5ZjacGhSkwVzLSshQ9Agh2lkfNpWzsTpldh7lZygll/AuGkwxY9zHC
+FbtEAaYij62CbaW3eh9OPEH3nirECpFvkgtnp6NgPTcTSnMTKhVcbgQbc33iTOiZ
+Its8PxsUh/o2F/+wmmniFbRtSD11eG6zEuGbqJ5W8YbEgnZlcsnSHNnDpYLD/CZ0
+J/oVV/GCXXESPFzGYH1a2x4MzYKs0gwSB5nm3PfVZgebmDjVs2TtnhzNetyYmXeM
+51zy43V84kgu70ygL1EmKrm+bZL2AEFU746j539G1xwQkR75BRTd03guchiWLBdt
+TGaW2cS5ba4yGcKZOhopvGO95yZcgsVrQb1ZlCfZIsAGp4RjwskyusTG19KBHavr
+K2HasXXTLw963NoaIHPGnQqqeVsu04rKJsO51A5JFwJNZu+wtpeawv0W2xvD7USA
+5UT6OZTWMlfy0QEifiqG7E59md1zWdBFqFUA8LwVnqiIJn0LcrX6cy1//ES0QgWs
+3u/7Q6ssuPrMw27/bmea5Hs2+VJP1uvQ9+utuNXxaX/MHHBRdXlPVcwjjyhOSuV4
+Zcz21u08V65XXQdY/wh3reLNPpRd/12tDf1TbktxNVWnlV+my7/r0wD1cWpLFYr/
+sSntQ4gmwz7W98IU+0s/cq+tLkKuGZTZKHb7Cld60NZggrMo+jp237iQmoincOuF
+8TCM7Nd0hw9Nw9wB5N8rdA5DNqJDstJH1bhYWtOaa6L1ObAzORKCzHMuQ8ZqeUoz
+EO/KdRe2HKnauvo4Q01xAkQW6EwxL1Jq5nWZ+jRpcYmgA4cjYTzjdIRVtVLq/YEI
+BfpJIzM6fm8ORzWMZtbelVouyCbt7kxKBR7qU5Oh5Bx3QWLi4cwBQ5qDmELzIc8C
+VCHgQDHsyG9v8a/Tykqvy5HQXD+bfajiZtnYR108KfRAK7uzJfngnA954C0dRGap
+tQmTKwn9G2zZjOQXui7w03JmNiNHnlR1T4ElXnEO2K8q7JqQi5QwvYX18ro7dSTB
+esJnum3DJVWQlP8p/ihxBKsA2OATaepVCO4cu+kRh8KRjsFEv780fUTZtj5jY2vf
+KaR+rr7EjdS4EiwqKYe9l8Z5bqT+FrBoY3S/uzRj/Tm5XLH7d/UmqX7VKGm1mPzB
+LtV5JfZvdUCB/0OT690twFN9/iuVjuk4sioQ6y6FXrSR/PUccEZ4tJSMNOJzgwIc
+r4xi6eze4DSd2DkxcviaTZ4hz2ciHCsp38r2OUYO0tECorMCfc7pzDhpgEz0s24E
+RVok7Kdpo6yYKNzTjads6EkAWc8ZDT39Ww60Op5DyEytwOrrkBhGvee4JmtNZ4LU
+/D4yhaMUUjfS5epU5owg0+YaUfLnRl+DEah/oWhRkRgUjILx+BJw6j0zNwWiCKjr
+6GBfg3+P+6GpYAz5gnq5hcOlFYa1T6FouNf2lSf/9C8+OM1ViX6pBJB2SsGyd4H0
+EP5RpsQBj/qaGQ8KyzdAN3EFQ1pb2cFUUAtLGFLAPaWB7o+QlcTQ3vnGZ1PWAP9v
+LEfwQWwQtq+G/nwkyDqAqdtakoE2KfvyJmLM+yfpuUGtc/Hp2jxPsnAgANWrqJBk
++m/NQFoxrG9iFoUGxP/oRmOZPvnz0/EdpabwQAO8ywPcLd+DqYPmJMxOc4BHnrwL
+/xdeDdxsL+7jNqmJxilsJhtzbshRiKEky2U+JeDcReHVnfiygZxLhlzdgX9kEpKF
+Rj5Rgx7t7w9FLV/Y2BHvHCLSZGaMi9dOve8Fu1DvHbZH8J4IQVMg345XUL9wdBcK
+v2dHzWFt6P4jV2axQN+JMNKdGlj50oDgFUx0k1px7JadHt24XACbhfXXP6bAqOJz
+7zwmxxcrmBqQujKQcBJpM6V5cSjhx7YC/DJwM9t02Muc++0P0KskmwOku4yjbR5s
+cLfOtFISh5zOVsYpEszX+4VqMJZjBqP0Ed/8FhRJmHumsqtFKKj705oL49FSpW9V
+bW0uQWOHfHNx8j157zlf3Y2hO6c3xqKJkzzIuyWK3mgqSI3knAd31spR/3pewATI
+CEaVWKpkhUZzyvaqMKMMLIBaPaamrYhH1CswAeJAx+3X9UkFdVswaCa/SSpL6lWt
+9mJHkMHNRmizFol6wW92BdPrTnb3xEea3iDTe/sRsQJ96v3I0+vgEyZlaCxAh8rw
+D22Yw+BstZY0/7tVdV++q0WsOHkBpQ4mImtUCQLiybfeN+hk5Aat+XLoT0R7IDWD
+llFWloEoOFPtx6BykyeUXHLdZ6vF9zs+q0N+g8+kViuSaSulmq+yCZdvhYQdxYKs
+sW1AYxiu3kFEVBND3ZVc4WiLsk7akwerGTuJrGgf8PLPycETvkoLz1SyR2bjnDPI
+dsGRQ75pE5atiXLXD3R7vdD7MjpidP9KntUItXTtf92D9Rk1Wud1Ro8g1Qk8gJ7J
+B6dvh6QWFhnOdVRkKvRkK4SGREpFub8fxtlvge9ov8ggcFs65Q8Yb+2gYc24CVAq
+jVOiveYTuKuclAPfisY6PDqx21VZBYWdjjaHjfiXpr2K8r1diQa/dIcSIZrDklEi
+H0pVgXgG0Xt0HjCu+vUrhabXo3u/IgeDTFbnOgLQI+8FU11d2NZ3DoH0r+aM5T3J
+Xa87IBNTD2J8KNI2O9EqT3hZ6bp6P1rnyM3KZX+iOZRtdXh1a59yddRFNQSPkUpD
+FaGTrNzd3nGr70a8EW/HIuvYJP3+S7lD4hKpBX28m9nNevXbxgtapQ9EznpdAL+D
+OxEJpJWUObcgas4GY/TmDQx2ZAW+sGOhKg2coD1SW0m1VGAxYO5Js1ziqyVwkEH3
+N2/QQVU1Crk/pn5AibVlA30y3vn2SK+OKq7xVHTXkpDjX+sIVj0h+iBIQQeoHPJs
+pyJSxmpT5b74w7GbMi4GOETQpgnzRcnDdtZiVFyLiOQQdMOojZildHpBpvbG1uZg
+FmY/75kU2vHB45G65PZ2wi30HqBz7W//ErnsaY1MsZ8wvix58oudA6HJ1eqHJ04o
+NUYef/6ALjYi36shQoLJKMG+rwc03R5im8mIXX/cCJEnC1/Rp/Wb7VwvCzBP6BGT
+QzP63q8YFPpogt2orte8kTRGUztCMGJbSR+102THw7ol2eg2hW1kvRsc2KWJxbPu
+bvR1zHdspMHxyugDaMXZ8SMDE0ucXxjm1hqtRo5OuOpm8fDdXXkHh5hR5YusaEqa
+1qWK7QC7XV0uoQyZElTKiG5uCtu4TOK/lYtlSitPNvDDbSKaAO27AUyUnZrHTZWZ
+7sgha3s3Hvtlm5dmSPFgwwznaDHgjckNsbwTmkzN6S72PM+aj5WbIgzfUDtuYEgP
+SC17GPegzsz6eYsjiaKgjdXyc3+M4ApyJmmkimO1mV4U55c7dp2Iq1P8wqlHC0YX
+41mQB67n3fiE72qkwe82ycb43aS/lPcf5Ytt8qhWkurGuWmLzOH4yVdp+NpQY+Wb
+v8++ESVQJdyiORY68SfD52EmoaCbKfz2By6H/NeJPUj2b+AiOBjIIcx6X38JGUTv
+H9O7e4R2VN9iUcYRDniB5UykeiLiIq2PH18PAp3WJ4JwrIwdi1fvcKCxY6lqRKGW
+g4fwfuYhn6/+fkT/3PgVrYsy06HZigDtlaW9w2ByrvA/L4gcYt+ulk6zY0TnR8JT
+s3pqBTMU36wcoVxs+hVZr6ByjJxvXHT7PQKAaugmiJsuCsUnz4lapQWE/XhlvKBQ
+zkPJnk1+BxtQ+wuQvxCF2ZYciuY58JzP82JwuHf9KP6d7AAn9awh14tCua4xwRrX
+mVN5BgX70qhyWKn6x8PXpeuh0+gONyiiHEx/JkM5lRyx2swuPAlYNYosWdXBMQHm
+HHRbL5rwVngAIzRp6zefukyEQFnSL1O8BVwlTpqIl9U8BiTM3kNlMTiruXEeiNKF
+GBuj0dB7q7TxQ9NAEG0MwuKoYbUFr+rYYA6F8IqS+63kOSPrsnOBGinASfXD6AP8
+VQRclIH93TY6lfRX1hXisbFljUFHIz/N42L2t2qLiVymNxf/PuBHfDzPhi9nbagG
+5KFbmXqoDXBdTr4RT3T0r8Nwcoc4BJFHgB2HwAHKnMmJ40xmD+qp98HoWReuLX+O
+cAQenCVBfc8DJPgCWRVfBiEsnAcQ2ZKdKzs6m7chJghYikmaWjxD+OsRpye1zkCA
+51IbTYjs7rVwi3LHY2NQ3NW5CJMx+Bg1o3oFcs8DhPLDCK6yGYNJoNYboAB1I3sv
+UWRU/EYItF5+PJ6bZR7aQIODB2Lz43S8VDKlE18NEJukYk5OXjZ9Q9dJCsMw91Ij
+Bok8eygKQ/kjpdbJxmt0PIsLLVXC5nNUaK1p3dHihd3H6sB1dx1ed0TouSyitvrt
+q/AJEEW25OHx5RGUc8WmUKHUBYeEH3cDPRwU7mtMvZvVluYh+KV5fe2C1OqChRAe
+P7LMP/o0QkzeDjZEo/+xkP3Lb7GSJ3MJHaRovzkpcEM/lCXuuX5OnPQfrKARaBIr
+exwwR0f/wBr+gaAgPglBBm2Tfi5o514xCwrFfQE3DtRRQqOphuwki4JohXl5nmB4
+grTXkqUf/I1wlA1/Al5+2VzU6/IiaS+olJ/PQgiCZRrVP6Ei/GTxaeOmLnjJuMXy
+roZbdnJppgDDBmcnmRJJvmmGVvvMdKa3+AGT2On06zrPZpTDDFTXtMlH+DDKf554
+mwdScazB2i5TYfoOwK9vV3dz34MNw/MmfvoqpBcFA7/EZNDewOnqcnYJzpfuqo/0
+zPxONOpanaNOF3yd5tcRymR005VvkKxzYzJ2YjAMf4UE7FJiR9cNhl94IZldOAHA
+kVIZMXptwLTwUUUiEYx5mSqKrHq0zPSc6VTcaIyJ3AEGcweto0gCof8EAlC58dkx
+suQYYhC8QwgUNre8qiczyadHkXQpxAr7Mv1ECIVFnYNdxHixyHr86sms1An6l5Ot
+v3auXak/47B0vNHcJUp0ZVSjchXrL2LOV3WD0mD62GVvBbwIkskl9V3owy2xVBWG
+cg2d6dTgmXH1lCx1hfwaWB9R4MeTaVbiV8uyv75mc0y6GH25qByKEYT4M2vlvRq1
+5mQvW+Vr+/oeOiDPklmWNdnAKrlvI/+TiMYCVTbCYtwsWe0E38PJ+hbzakCYg6k1
+IrgI+RqMNb071Vya4WZq87/qyOvfb5O2vxFtiDK69AHR1JIZcYubzhw7dbFaGAw3
+cV771skzzdQqX6R0iaVHYgtx+M93UQgcswafMZHTkVn0eRqwGm24Nq0ErTv2Mkyn
+RiDfpCj6VPHH/nc3MSA17Jb6/mVVsjgMOau8Zg+pqR8wECybDPomhuQHvi0jUyFN
+1BfB0KPgVC41RCRz/IeuWl8mr/ESDELW36INkEpDdMZEt1yKiPAT5sSC4fa/VIJS
+hjaPpeMN/59RJ/BeubG8uxKSc1B6yenssTQ7y2X2JW0OzDq8jaHcWIzRg/Wevgl4
+cavP+KCZFU9b2SPFnllJrcoYN3Mdfv0VcCfE8rX0C1WytuDfmVF6Kpjc+KRlJFDT
+dSCj7/SR1d4xDxhx2T2BlmpnidR1WdTNx4Bb4q3uhZ/GXmoSnAqPSEn4CI1fhhgZ
+YPdYGEy3fx86IZjgGGtv2fxFHcK1vTcBiGDoUIrLeZZfXdN2xHoVtklUfAkVPsJu
+inVznqaX9FbzngzYEsRxDCRHJcu9c5wehmNSGILGGjqLvhVeJPvBFErjFQA/tU0+
+7+WuSWpyTG8gkXBB50c61aNy28sdcsBBsoG2kbIZrGHUcKmWY902UXlCQbsDW0WW
+SDE3+IolntzEE7vKaiDhD0wq21ktRZU07eglbiaxm7ryzwjVm8ctKzugXW2U/Ih8
+um/Z+uHVN2HVPFjRLDJrh68Rgpz8XcJMgY6BAPHRjzNNREH7yVfYYaxSsV7cLFQ1
+wmsQC1zVAPiq1WORG2seLbrpM18hZmjKXXoGTfg4T3VubPgwrdu5hNDPaY8UetIi
+KS0PS+XWxOeTpY+4aZK9Y2fbjOUV4ZE1cZAnc1HVH940FpfyJ3BXYz9+DCcwCDMs
+DovYXcTPZ/FC/BflXZVTAp2p1nzGKU3K1z0jD3jvrt37uGAsKczXpd5C7JYlJYEG
+Vborp33rRPK8KXExpcdj4bkn1DJ2KAkMHaCFv+Qih18yEOj11U6xIOK0UZPcgc7I
+pAelk/QXldmKEP4s81pnW7WmipcZfpPU5hcgQ3JE/Eqf6UYGcqsSgpkd2Au7AQDR
+7r//zkYwZe2OwGdUmBHNOrTrt7915RrshoZuoOF34vABUSRLfJ2AK+NrVnjpziql
+QYrdMxM+8H7p+2oQh3xOwNLYByR65CQmQO2rFSkU9SDoCEAxgPjVSEunagjYpGHr
+J7cdG50oTMbh3vMqd7+Mi5HwWH1tHUBVO/E9goguBP7WxKB5cjtoAM6qW1dFo54Q
+CYuaG1fugOoXstfsHdYe/8ABimfJWWXWvV1WYc0dViA+45f8KnqWec8VPheY6pVi
+wWWvuHINcslJjluUI1NrXQK6sZaNz7nfF0qXcrbSDljkbrj9v4oq61vUHeVmPATE
+nN0Zu5iy+kZ2+98iZYRV8crWziQxUZ1zczYPx3KbwC2z16OtxEiMHgaJ+5QtizE5
+uJFgr+6LVPWg2MZkuzu3sQ7m9GiHXWsU3oJu0QiUoSkKH3YZciSPijnpwTBh7sm7
+uFJ83zmakjohApqzVhwHFWbiDaN7nzxp063V3vcalh13MBScmzePvf0m6zYLxr+x
+fNqbYaojLz7BC9uQzuCbbS6ztOp1aN3RG2/c4Xfhl4cgdmcoC1CDYnZFrZD9IE9k
+u3oC8aYtER2K1mXASCP9p2OTRb274nV9YV9SAVKzppwT2kXfQMVY6j8mqMFIkcTY
+mIul21w+pIPJpY16n6nYl0u85PczlZ4zXWWUOI83SYiCa9MG1f5y+s/7anaS7U4v
+ByilYWww7xYDoG7IjbPwIRb4vvL4bMJ81prZWX5gFS1q17Nrkq4b2Phx1sgB70u5
+by+Uopa7mZeqnHvYJVvjLSCKQGljtDa18Yq8hPHO93mtwCn8gT8ufaOBQW0HY6OY
+98hifwCOKaM1pHfeP0VMzCdDFd0bn6fNHE26zt0/IPQRZfnLK88zU7DqWWXHTXEk
+4eBmAYaTWYoe2R84U7HNU1lJmsWy4OxH67fy5IyGrcJ7WkGXr/5a8BlrfWq1z8B7
+k4cAVmp5PI+3vCP2Qg5Z+aDARA5NZZeqmOX2is2aNyQcmRUmOkTBzGuOqTiYmX9/
+Q9BATR1tPG8RFOyRiFP8qTJe07qGyAIvkFb0uXKZtPZBiToC3b39Krd2PR6DLI9k
+ga2nvLNsIWeRH0eRaBEdxGq04/RjZlgO15deH5rglM1A/gVXszB+FsuvXdzAeou8
+9Ok5yDfkSpfdgt2iVnGjv/L0owKeYjipkbcQFmNDh+AA9H1EWCEgwziSsEd8dBiP
+VMOlI/8BHPWT1X7lyqjN7TcCAUJuwrcrUsJIX5D3hWpN8eZp+3pXqbGcqhVFOOVa
+NEYZSAjqNqhg0Uto6uubVn5X6BNCeMtqkE1Ig4A1pgn9SzcU6gFs26s5gG8VYf7V
+fzRw3dzmjBV1+GfcxZIcJjOYjOUjbieKOynSH5QHONf9FHtePV0K9gDNYOwSJldO
+EIYfBAmWn6U0Dsb+Cmze2zdaD92G6csnO+wiBSXMM/zXgkTM85qc/niRWi8VuavR
+WhjbxKqzj3NmEErj+GH9Z5cGSBLSVl528ss7TzLekTCZjdV70ZP93DS3fFV2rdeR
+bMFgAmKZS9m0ooMn6e1JSdss/tOoJP5qzdfaseXHqnq+UvsQ1j/oyvfkzfxwxw0l
+N497NiRTI+azWa4BAH2BGv387xTK5XsCGHRnNPaFXugIhQqDx8xrpjdVoH+3hLrt
+ibDEQJdV9Zu/5XhYKUML5tCwsGUC1DXLXd7nmynN58FA43JirX6tU+DIn6LWdsb0
+HWgALsD933DBte/+cOAbd5g1jfuXEn6DG6SkdGXnHjpXg4SRuAqdMrnS8PfpQYRo
+7HFzdjcylGohxGX2a3Mmn9z69SG1kJK52vYPbdpjOs42xrukIwcMerxoiO+zx46+
+61BIHjMfkLdCZCueuyctUNp4JMXaoda1bgiKE6H58+PkI6yjs82Aim1OlzzMqALC
+qEGsnaidy+wzDHKVc7Lt0mIkz5NAV96Eb/Kjp7LyHkbL8F27zhYy/GtzAiSgTGUW
+GrZM0G/9QgSJf3jpsQQ9HYq8TDU7SZUoRXOLSnhUR7LKNs46tR+Moro1zEXINtiM
+81rnI8tLMw02LYzMUweJQLMHOsKfHcv/lz56knkboRQgQYt+ziln2D0+uEifV34X
+nwnFL8NZ6fm+0VpEOLY8skJuTSNIsavK74c9EbFUxwqhivJop6GGMcGxHDun3ir9
+i5G8Yqnk4pFtqqy8zKgh9e/P96mieW8Tiat9PGwg3LpSj62YRdNibQp8/7Tgaqy8
+fuvMnEG2u6lv+ooeSiMlg6o6HoJ4B0k9nSTfcWdqTT11zxSzSPrnx6ZF9dQwWieU
+7jwO/SRg684J+tDXHcbLPl6uLX3Z8o2gKhajoxbghBoK8/L4VEYNfmEVjQCTmRo1
+bqDUiUjSmoU0QIos8X3ih8I+KXxlGrsyNCmT2Eb3km6f8LroeO+R98d2gqsFnb9X
+cq534IkFBX6x3Exw2pNGPMgXdqWWItBZ0nZhbnxNIwJhijBjHXj4mi7kxbC6VF58
+IgkTN1nS5+7EZcrpQvAxVR22U1MFrM+2/PBN6NtnGhfxL0gPI0U3kerBuVdYibrY
+p4d67y6xUTArs3pgnuDG/TuGx9pUVwZECD7+q4yckjuItbQDnMVP1REatKLznf33
+pLD6hYTVqAN3wyBDCThKPu3gVtb6KccbofDv4+MC0UHmMBTyRh6Rsh9pfBn5Uf46
+1Cs2hDjAD3ZrCNRh+c6Ut6x2gPm/HOD8bCKptNWR9g+HbiOM2ioa3OehQObSpSRM
+PDp/tGA0gW2/gk92oHCUrd6EXLPnLillAB7lvI4ylyDCCou2q67edpby0GyNEbmf
+boMDUulipqwCFqLBJfr2j6IKTnbXHlS5k2COV45Q31jcrs6QFJSXWYT0jNvjhCTz
+/YpLDSKyMGjtD5MFTXooKQyMcHkmALkVvV+ktMGAcZXK+0FCoBtH7hr9s1g/2B3I
+PJlrL8dX8pi0A8xSZ01ZkTyJF6De0uOkyOLfZ8dt7rGzEdyeaauPtRJVAFfSLLMM
+g7JP8nc9kPGXJisCUmDEUY4rtU9bi2goloNk9VjAVcxhDPaC4C8dRDsTVqYk+ndN
+KbAgr4TgEfha0qnycYwcvZtCFCnUptO87JWERauuOompXETiNfEHNhNTHv3jgMwY
+svzOl2HFqN3I6v7pOPNyjtyaUaegEfG74k8re2rljsc+zVWzA5ClfJ1zEOTVUCzg
+XqgfA75eExxsaud7eBZFXYMDFd+ubD5LCOTJzJXbDkRjqP/re3qDxWtg0gj3yxUy
++FtyX4f1/Rr1ZrQN1mAQJ/tyFlqWci+mAk5Y2xDAVdcKg1xQYYhh/lbeGJtVdIE5
+C9J4jsi9RdNLZKMZY5h8gwgatcwakwd2XwHU8ITcp2xraYQyj0w3uzBx/7px8eD8
+QWGWsUUTNycs5kVC0bVaHaXRYiQLAOwJEPKo+Bc+PuZ+F8LGPXh+GhOdDoSyXPAe
+WxZa0b+KuEHy05Jyq9FPdx8taCF0DEOvoOB45KK4xM3FezyvLKZuxVOPu9nmMmDd
+iFrv1+ZKUnxzmZB94laq4Gal06grXCG9DoQOrgH+5wHTkMJB6BBluTyCYpQFvIRM
+HureZxQavU/smWQQPhnAzqqUbHNMj/aZOqbcl1kHHMYvHdHBiPgcaeR+y8svf/uY
+c3+uMBLLjEvnpXtqt68ugt1B/T+TVhSplFkq+jep+ht1Rj6Rv8kJPc6wrvpHJl4V
+L5cSwFCY9EYjVRDbaJ7UWxRxVfiAH1J9A8Igs4gM1ho2DP8eEbcZX9nb01CYV463
+S52nlbOpg791GPpsjwtwvnR55g83OwDBiLLtWTKLrp9cAM3NdqKlQdhny0FbvURM
+AP7P9Bi6YI1H0dtwodsdCtlAwSrvrDcYD2noU7BEwdvJ81YrzVToWLTOHXDqADDG
+77NWLhJfhG3vGzzGCUrFIganVmMtHl5WpxDYUyRqEYjS4Vt2CpUzL6cSTq3tCxE+
+ZegDhc/m9UU0t5OAL1c+69cUVSywC4KOeLLDW8XKcJ1gT4vxHH2jT4rH+aZQJcnt
+hzUfOxdU+tJPMYEhcQulxuIxQAMXNX0Z+AQC2czv8DxjYEMuNxBCmfQW4PnIkD5g
+1IaFzFntXhv+k7i6SjvrfQfSI0QE8pB0phVnxgtAnUVx8lkvz7xdc6JXDLXV7yJk
+QqhqjGEyViln2/StEmESCz1XTNbH/cGkhliROkwWWfxy8kkeU4JmUW96JTooBDG6
+c+0zxxJCMRYNf8yN7UcEmMkKlyrO0A02KMFduk39usgMXaeiBiNsBChVJXPCElCI
+4Y38m9dT/pQPGIisR6Ux+tIcJftcjwhlrszhAacxaF2uw39Y7YUhf/yguODHh9hK
+98jP4fcv5afyEZiNs9WAYD18Z5hoO4qEMiRrtXqQnre/2+51l6/8tedB5XVpesjY
+m4Vb8q8/uz68sR1fhW8XYDqIq8d/zHECow80/TtOZC99jvXLsAHbdkGEPWMJ7lNs
+nloEG/XtqxfqzJZwbVDQ++YvwMaYvMeo3TETrp2dK7bZxtc/0EANxvZOQOa1PS1T
+598hnl7M1q7DOourJmOLKQy9PoBPzKOSug57jM+ghBBehuqyg4uVyYJ0lx/cRqUo
+CIjoDFiHK7WXGClK+n6hQx85NHfTaHZ+TTjXk/D6M3Cz/7DFwbA7h3J9UdErXWTu
+Zj77Ce3p0b8Ftf2g4hJdYjOm3xAhaRN1rGpx2XXiBsYIK+kkhRgIioOLg/qzVqUw
+abLi0Ihu7bvIE7wMTUfpY9+sNQ/vsBGjQvGbpVNMnnl61wAvTAzXfWN9/OyE/Gy2
+JivO4lwC5W8FuM7tr//uM5T+WpqJVaDHEsWeeqeED6ZhrsCCkNqzwlBLNTKl3Eg6
+UADteNlJLGTPKEvvl62TAK80jCwAbqNEoQDsbyDD/hyQt/PxHZ3efd/8PSUN6tcI
+kK5qbFCAPCyBZvdMWXfSSb5Cm3pamh0xLyN4/Ea+GykjUxGejBmVCaFXr4LCQBbL
+X2mjig56BQL9WIP6ajpmJceUPlju8medEWD24bjyWEg3ay7wMHpGlD16Ecp843rq
+WQPAfwYs5qEo6EuKbx6BN2D7r57DFR66Mpg3fBSM6ETbKhhzYxc9UXL5mQ8rls+e
+kc2Hy5E7ybFTeqT71don7tTg5ovcPg+f1/U0QPcSj/bmxoO+bzpvUe6HsXr4NCxx
+PgIj6MRgaItHIM3pjwxMdDCNxotnWC7ZsmhwLrfA1SLSwkFXjruc/F+f0GO1zoHL
+7ArDhNccok1TfHTdiEkVxLYtrrx7mpUPw/6Op/2DQok0hXhPmpv31sa5WTA2tWOS
+q91SWbsqoMHteU3N4e85uJZ4ZVp2yjEt8EKsxh6anJseeHQZ+Yl7YZCPv0C8wEBG
+4P8Bz2RfKDTC7M33yp/97w4FcuKp+1QxpY0NwmEh/jNiE6JQo91XHiJ3jWl0wAMb
+jWbQl4rn/sJzawdlju8Ynt45t5GyHAH52cuWAY8dGtbf4cJqoqQKL026auR1y22x
+jjL7dQKd/Q4m7FVh+TwbBgH2jo3fTA7nFRfi8MgChznHKFKZjQRKN3PPezDBEVU/
+4wLAjueFnSKjMUDOVMndkgL9zAZue500Z/SeZpls0XW8imMG6PLyALZjax/WCTrl
+DfO/yy1zzQdtSLf/S5VoxmEOL5oXPrWqv+wfr1UovffhK9lqT4YN72gouRcUDk/4
+j8hdLtUfdKop1KnXHUYDOqJhG/GSlhz8slAdcLJnQNJU+EdUG1i/g3wEzQ7Hp2et
+OsIeOFxNffek5MoOt1Sj69xT0UODsfZm5ah81ZFgAZWkeoRXqaFYl/1weu6rY7pk
+cpCxNsfUS1oC4eSuQeLlzEnx8ZAPqKTUitdy9piSQ5dU0/ZdKXqU8qF2Eel71nPh
+BEoS1l/Z3dR1B/Gw6RAidsruxHqBrE8a7mAAHDNrjFKpCJivsYYyE3krbv/wKWfQ
+/7AAaaDnG7qVdaKFAP4PzQe90VIwsvaP55sl+kk095XZ39BYqa4Wp3LfkAFlAN7m
+wX7N4TJGUgMFnsiM8oqcnslmzB68HNrVFyNyjG168L9jYXPaEeWZdVCzvBfehfDd
+er8VRf/fneMnFeA+YgabMyKHW7LNpcEXhZBBjO2LeWU1ka3k5KvBi7rfOhuM+/ni
+ZsSvzqLdRglY/Se6G3tN4IT9poBi/h5Pf4eiOs+jwX+Us5fPxmcU+Rw2P4CLK5Oq
+USQTQgOat6zf7x6wz7c5SVnuR5mJsxs8xOv2Y7iXB62dM+fhvhNHwkW73e3KMuY8
+7s1XfFNUrx0S42/gzcWx6w6kba6I21vlCbHzTRztsvNf6X+GIkJWayzscsLYrVkV
+HIvSRINqCKy7iXuWdAEwhynvhx9oN7me0YCDk8e5DuG9bX0bsvHOMpRvp68DwbyP
+SYRhk4YAfMuFk4eTWzeD0yQffS9uch79oxVA7RsKMqY9sDSav+lp/VKkUyMg8tB2
+CJnRGVm7BioVfbsHMt8BNixuBu+aKm0CoBCci2liODHt/XQ/BX3erjBqqmTFbQdm
+UhJJ39ZTKRdMYb9SqoLUpjaMoft0xzBswf+KmoYw2iVShJcplUbi/yv3aLiPrNcl
+naU0R7iqIFFTdWsPmr5X85Ze7l5p+ehBQq9Fvc00Od3uDmL9J9A7olFzmv/8qZeM
+XqJAs24k6mGon+BRFMEL1mbNiSBKQ58RkfmCo9OemgZJYY/7gf+bziCCK5YGKl5C
+O94ChB3LbYY8XKII92n+tyOhyJQiATGutOF/GTMaM5vXszy/SpjacOV8nF/+CrqR
+VSOQYkWbYP3V9/YfoOnuJSWmc5vInA0arSufyVvcjK4S08DqvzkdB4vF2g7dZhh/
+V/cziUjW7qxu+UJ79U5Rj8ipu4oiAyEeFys+UuQlHce4Ps3aEytb6PqB/gVHJ1O5
+r829K0udQ6mjClLDrnXh7gFw57kHeSX9rMvJI4LsOeruioOUcNiIBjFWMjaO60q0
+Ipjd9wE2k9KlUD54XOVtGJMIyWMx2dw0l8eZJXFfnRyAy7MCWhb8qJ7mBpadmUn8
+OA+6LW2bdpMNsj41HCPvrV7eV0nAJ9+cSaf2d1UZfTWjO1ziw6cVi/JIg/GzfDCe
+ww8Srx35hYeoR0vT2dbA7FoAk3/lMl9e0u/5AWA6I1K10NlJmL0eVBK8aqjNB3T/
+s1LaSdT8fpTIzKd1/Wo5TiQi1US1QQmTiGs5ZCzwjQ4ux1lrpFzwhCPvqVUBGbub
+vt00xVt7kya/ETYZ7uZPOezXPTbIvPcFW4tGGRs3XnW61jrTdn61+oRDRmCG3vAL
+Yu7AV/uu89DlkOrxfbuypAjVZTBm1u1ioca2+AX7wGzQhz+rSbdoqXsLR2bmj8Hb
+VDQEtrnzbuUWUQ3S7TACvSf6ylDG99r2wfbonhjU7thS6R62JGmrNGdw08qN5PTJ
+X2ybg1o9crw8PrKjk5SYgD3pMgQaS7ANSocsy3V4HNX9cSmBvWk9LFKSPulrvErl
+DR6qI/PimoPVPhcGy4xanvBtXN8QzPpcMQWowF6ps6fLGceLl7lJtzUb4rjCq0Cv
+fI3fJyh3etIH8chQOwTrQWW3svJVZdYXzg9WA5EJkVFAeoZEXyFfrxg3lf6wLEdl
+ZuOqxvcuGRkqSL5QYFqyfVdt4HvqNfOxyeGsYm+h328rTjbvGrgVlsHuxPpQZwo8
+87YUId5F7fkZaRrmBgaL2K5r5Ruj5pVfuKSMaQc1BxRg9lQcpHDLqmR1txdVpA0m
+7U/8u2qrdswBmLGWIEbzS0zfG50Pvf/wxm3kz/JnJeBzj43KhqhgDxFDJePuIT6b
+9mG9NvelWArkJsHscTl1B8DB328aZYNXBPTNQx9c9pwjyXdyP7CVgdo+F6kprk1Y
+qkmQn+4TDLnZC9SBlywM+ulxykpzu8wnAPloMjx5++KUf82+sys0WGuBB5FZKW+S
+prCREWx1FX6ETAQdHJBpTEGM4l9z1qt/FhLyAPAbIvEC4DaFEI4/DBj4vJDZS6ke
+B5X9u1oJoS7+WforMZenLcxt9O7NAIIS5eIUXxiFLkCR3K8a/ZZj4tLnhPBpTV/B
+taszoTfGfbnAbezwaJilbiPbdln2++qsqt7SzBHmUJSAsNDMQCDq3GjYE4l/6015
+vD+AX9eKwiZpB5+M+MLcROuL0l5TS/nVv0CJVz1PqB81gy4Vjl8WSXFoQ6a5ncNN
+FbzNfFc5PL59b+jpS1jUCEMqqe/aDA6rCKSTwdSVH4iQcv+LSlQeq1XJWNpLnKz3
+d5670re28WWJXNtnHvWlI2BSUvvIQcW5dQ9f5Hx86jbY3hXm7nKciLyfDjluDZaB
+o9Nkvd+KL457+jFdnYf2eCeIU6W6jYlZpiom4IKsAhsUKhfzjlU/mfcvROcfE8Wd
+e5Rh7LjPhe0dHZPKrc9OEHJEPTqypOAeKH79ixWvL1EgoQ/HDcuS/yWXkOQ7iAmq
+3ty0OeWHFdkOkhdaoz93ZYbWkBf1Y4WcaZSuu8b4qWZBh1YnIeb9wUg9BSF6pcxk
+VwbK16rPo+rteYetmMUZl/lVQHnzoMuLDxjlDiE2j7T1ZZk/Q6iQBvoV91kLrCbb
+DLOv3MFbhuF2padWe287pGHkyXw1Eg34gjUMkMKO2zYqx0w7mT2S9fp9wX7q1nqa
+ps298+3WUkVqtTz6xcEXd7ZrYEGMjeQZF4hJ71cnIpzDvr3ozfDyVzsHIpPyr7mt
+8LzXfaeNIq5fOyT25FbEFto/jYDoUsFZoVpq58k6Z7NySac1SnuPUBxvr5DkGwOn
+Gi60oGFSGnt7LHOffsUsysaawoQfT10XjyiEqCXI73f2dVaxLNCuo/28FbooqTcF
+dKqWQ7gK3tVrq0BX322Lc4Y1/dFEQ2v7HZFdVXltWPPFWHVUnMkr0dA6hsuKIVYN
+BZ294SA752022uscA+PWUj04pT3T7OvR/WU7IMZOhk8UjqpXlmI4QXfdVhRthC2l
+fvMa0W6+e/twTtPCNgGD9t69kjYbd7HXIHCzDPX/v7eNVlhW/eOlIxwI2JvyXZXM
+QrppMuqwUTxGVjOfoex+JftUP+Y6GT/KXdd9AxQRjXwUGgtbtXb78ABgN8OkdGB9
+mEybXWJYw7S1BJGVFnhqbxTeJ3e25FICnPXLHWME7jetrh9mcxRVyRy448rlcOOP
+HL5RhPAL77C179+l7aT227Tdov1ATifDDCWsak4bRdHfD1gcX+RH6cryCoRENwTi
+kjMNbedLZpLSoymmNBsDYkh/LoqZaPlzzUYW8uv2CxR4dOYibLRiXLBpA1GSnCNA
+psENL9bR3do2SmyTJp1FREQ/0tlZukDZZIKENDp8PsKqUqdquj8NNmh5OmJGQI4R
+wIF+C1dh7ZAAwfLPYbnNO2kgH+lNdSx9cKVRV40Jj7GFb4oUNOV6wfHXPVbW9txw
+VBCkKYX5aXbHERq0kmLJk9Kq8AWHtiWg4q1QOt2p7KTthUAPhzcLW9X8D8yVKxe/
+uWs+eyFcrDYk/Uvstn9xunARuAdpgVIqSRlx+KKrUxeP3VESPIowQisI0Qnn8V/I
+ubOkOhz16QwK6genWgucQA69F2pmTuu4FWUGqClGsrL2cjP1Ht3xQYfvz1m9tlJ+
+BXXo2bDjke9sbvccURqBD4m2odjsSNyZ7wWqp59OXCJ6Yl6oxbQz1j0FR4iY7/8W
+GyCf/FF8LyRqgQPJwd1joqz7zYiKxEPieiwJPudaaP1CMzDxlNo/Vs1rfT4xqRbw
+ZwETjSaZYhlNqQMrXHYpP9lFCHsFA6EwwZo63G9ENyYbo+bNzIvPmPG4Vavm+C4O
+XKYtGQcQevq4iYniAxEIYUi/HHDyrUW7pjJDJr39gmGqbLP/wDYDycDEAeCi/nqX
+JBwH3lveS3n4MGOUCqRtT5oyepSquDBUWlGGgWtQbX7npv/Qyh+9/rsLUXLfd5A4
+n7JQTtpnV7kE7xNe88lzZN0BZ5AlIBtUEZeye0CmN7Omj56jN4L4HKoDPaZrYWTa
+1fPgMcVvWSEi674eGMOQYeeMN3Y8sQPT6xfHX+5uUg7A8UgF1mUNjwCakoW4J3xk
+dLwE9+eOmo0NpJhWQ+0ug47L/Sqk/lVvec4+72wYnS4EZWrnhHcU7TcCGEyJFWDL
+ejqsOH88o3w2tinDBlVmNHb96KO6sFBXZUyiIGcq60jZdN8uirufIeW6t7jvl6su
+3L7+LgP0r2Y6JedIpvdMNNM6ZEMK28mg09US643ZYpO9iMl3dUTKKrKHs7+fJrOQ
+NxEKJtxRbIwjeK68RkmjktPmNAxYKX2H5MOuzFx3+Z5TZKcNd4eCNrp2vj49xEL3
+WR+ZzwjsvM47aOFeb3glK5D/k8fcvhZIzEunAiGUvZtUIrI2VEpf2EuIF+bkK9UD
+LJO0x7nU48PEzwrlZ4p4IkvIeEYz6u83cTx891QO+XaZ/ZimDiOlKkV7r1o32CF7
+aV9Ywm1ln/+8x74DKc58+GsL3KMIe/ncQ4g6tg3DDbxulEpVupVS6C70yzwW4lHb
+EvN/5PZkGyvIFYR3w2aqxs6enbPTfAm6q+VL/Szp9u613n8DSIH8Wj5HcDGp94PQ
+703ME4O5CZQu4q6x1vveDIvJacB5SIf/4ZuRLjEnQ7NSnrAk03jixiwSvngy0IB2
+HGp7bRZ3vFmr/Qesyc1TbxQ1u3kqwYjP5LiCuFz7xvrUEVEmHhhtnJjrK6pDu4XL
+/VXTX7jLXE4Lp9HoEF7FI/xxefUs/qBC2vBjuUioitJdphUj+NMC9Z63mOCqGLCn
+CJnR8CdLPB3Gc15WO8wFtFrVDrwDH+1jDughj/BvTMbj8Huq6zQCHAVE9B+aaLxT
+TpYcNNecSlLUhA010/M+ZdkEffvyJUSETRxNMzX4reinCcqgLUzD1QnAXHUK9HE5
+rgOCnO0XvZyUp99L48sMlQcfzqNDOb3sCx+VxoOUNpshshh+Pk9UlGZ8evubYs4u
+hkSGcw09JTes/lL4mC5DQYcQxGQypBSG2zFBna6wL7qkUZttDCXxWimQkg5QYOcY
+t3NAsnPX8cDniLdnGdyUAk6kQBSq0G7rpUUAVJXVve3K+FTsp3BnKBV2WqCXIrj7
+icGxpbLYX5dcXRoCQtMCGuhjlZO4+l7AIf6IajInZKhT6WCVHBbYTs/VkhryPMNF
+IEGzqiZCWzuX/yQQdTkyIGcK5nnEfZXGUdQB/aFCCXMlZrncfk5HghVQXWbYqqTY
+rv0WzxyIQl8+9dtOELaMiqMyAHCDoq4e8oJZeHMItxaXn4c1KS5ENvm0naCv/NNR
+Np3Y0l0mPVCcMjspWVnGiVrP6bMqPEl2E6x0C012M/uxldih/P/qlnXgmNselFC+
+U1uQYIEdOEDAj4wG5IVYF6Nl2JMxiDyGrLvFH8uUs436LIK3e7FSoXuljYZAfieM
+v15ngEbSSeyWwfnYM54G72eqIC33Z/s7SgTQTCGEECrwXOzwT03ciacPDtovF4bb
+4gKfOKOCThvKLdja0LqLIzehcgJfslnuQ9qVBeljUBBAusxlHRbd0WykqhcJ39nw
+aZ4ItTYKm+JfKSNg8e0SxyrHORmBs9FMFLQ5YdIx7wTmx5sfG9dI7ZpuJB2YKQ8W
+DUojlKX3sHfe+8Ax/67VzRfrniz2JVqqbPwIyYbiJgQ7RxURYFPmg196721NfQ+z
+OqOsZfbZwNSNxQP95dq7K0UfGvBz05BzwqdufPS9+39vNO9NFdB24oxd14a7Yrgh
+LMXIfuy8f9vyB8s5tmKFNJhkCWkUBkM8XH86+3qbR/oQSJ5/SYah427a1NuoDf8F
+bqoBD5REjeisTqZ7DA6eTyie6K+qGeHNuZZjlojlUWpeRdWPQUIZuGQrsNJf8mzr
+F70FT8RmBiTM2uqkT84qQObcWQ1GDUBm7s2ZbBaH8vt3bvNqyX8MYN5pv4aDtnoJ
+iU9teS9EKt2Eg8xHwYSPR63lRuOh13PRTWoZCCvX9a9KXU4iGummIZn9FeDSwDqD
+JFrZB0GUsybe7NkvxgFbC8pS2CnH55zCtawBa+Xb8FKaQq4R2Y67lxPKBqobndnU
+18AXVHiJiZm0cPa86gJL1mkJElf3OBwNbRgLT5bxTUdZIZ1cT1BF0zlkHL6qXAl9
+RRIsS0MWpcMvhPeXnBOKZLk8uo5TWodaRzX56XWW8nbByFRAepgx3C17i0hTh/t7
+296mXPBNTAgxTTgQrXTGcgsRckI+ksMoFJ57h8Ig5eRKQgOPcyaF8gjgfn6U9GTA
+d6qqqKmciJkQrkVo5S8Cg6UjxNTpGvi40crgDcaEbdMa4D7AZRJUp/pBXgS6WUky
+gX1R72GbzeXErAmILwwFmx+66r++0q79I4WaT8QzsmdozzmiF0WTG6W35Uo6kFZh
+6zysjOcHqzeCtdnWF7w+FtuaaJQc6wYsYrG9GwoxQsgDGXKNRh7AeI1cBA6Z59A4
+CjdfV1wz2cdF2viigwND6hHR3EJKPTnspppleAHehcj0AChf7UfYq3Mlt3keKukw
+m0ZvFLCuFZgAe0soFOuZ28KzN9AuVNGllz26HXlbYqY15WZVOljFB8u8KxSVkTIa
+EXa9C7sNAId/taeXVxoV/+2erai3X9u7gc3QZeprR8fUNpniZquw2DdBwQYTEOLd
+i5p6+078V58SQOa319QpZf9ngCiN74knCuNzXUwID0ao1+TdMYyBCVGAtUx7xfEr
+NXf7eMPl2td6bV1hcteEw2Nn4keuPLHIfbyXrIClxPy6J2bJMduPP6ExNn7JGXjA
+J2j8jxjvVSyaL8E2Fi3cC5UwbFhMqm6ajPwc5fro3q0Pt2bFI28ewwKZekrIvonh
+JX04J0C8IHVo6Srpc/GR7eUzV+Ct3KXPToT7QvWISk1h+y1w3jbefoJDx2uQ4bon
+cIz7xz4c5GfIxWA5uCVsFrKozDnWhy04BvxAoeDN9vCzAEd8F2Y9W/5IZuilGcEp
+zlVuK7NJCQ8WqdFZqERib1f+z39pV8VkX3UtscWJqk+By8ljUeHpN02af8UHEUCD
+VDtceRdzP+3IxJii6lPlcjUUMMXCFJdAy9L7Ar/7IOTI18wF73xuOe+Jk+qFNIKz
+0Gc2eoELb+i78Xs7qZnH2EmUS4J08omDbqymcRAr+pLH4ps8p8O/dfNw22qjjCWR
+6hHc3XwJZ107Kz6azVHgnTgNKEdm0F6MoDXNMd3fhjyXUto4vHYQ0kC7wPwDKxcX
+0YIDSK5qt/rd6gh5q2em4qUL1v76jUXMtcaOvVLVLwAFL0FUF7Lfe1EhYad/KIUU
+ksJlPs8rP1bHUuAXT5qRUY+kTPtD5E9yZYjUdEUbQkovXnJ7ppAa9hY5H6wM7qi2
+UoedHYtfyNaj5tot1GJY60Ji37zYdzDAYx0+EfHN8tRe3JU8szklQ865laxtcmfB
+FNybkQKhrOq+bCMDQXaNvwS65TkiBDp5+Po/nho3P9A0b4TmEfa5fNm2hjDF2B3Q
+doerLA9PzxqAuypymRRghM3t/NelyQ9T8oPrOk02K/98TO8b//l9e24HGym2fm5P
+au/JItc/mwbcefdiZPFYRm5MS4qre6t5Wjdymef9cZezj6RW6hZzxtd++Aj7im7Y
+iFrIcRnwUJCUAKHfi2ncWf+ax4qV5urk/YugZcCerP+eUK9XQow0vgHrr04AlWt4
+khVR4OeOhSEXv2DUWdylXjybhn8Aoxu3dOtMYXoXJZlRM5W9bfpR+7XKjMGzW+T3
+RW5MQxLz5Bqeo+Evvge6d96QT24uvdksS2yrD+frC+EW63bXM10qCGD1dLbJhMGy
+hR/yfpqLdcrRbJrUUKJdz/33qZMdkR35vBVEfAZGiTgMPj3VWSxt2CqIKBp61GDo
+gYfLdkZWP2qRk4/o05vbpyCTtIE6RYrKtofO7m0gFqx1gFadO3FZ2iToqQdIZqkw
+5jWWWgRHzzFDl9mZwSqRkYAIWmaoDkVqiwhLiblfyBwt2BBGhYuSydwNu4u752Ii
+JFhh1wOQd7xHp7uJdteoZpKKVtUb2AhhkXJNrbBgcQ3Y+/JQPiv9DXpwOFte1Wb2
+8jYQP4eUDG1X4iRh4vzPcFAWkd585IRC3VTzRGCgdq8sUJNqIdNP9SNgNe89Rr/t
+l/Z7Ngadz944df7BObcsfX59FxSHTYODPjcUixlrkAtFXF6KdHslQOZUI/a4vlF+
+4JoFHNTG+BAjkA8b5XXs0aqQg7zzv5OJrAPCdtwC3y/SF0kh0iLxQMkaXyelwOBz
+5H1K1/3VZj+IvhxofC0F+84eDnJeIVDueQzPzaS9Z3quJKZcLaeD4ZGf4caBLJtc
+AMuoW9t9JFqvBRsXMXlHpNnXycw8JgGpreV6slnFmXcrT7LJRUQMdKwlqj/QeUx6
+suBJzsxlGbQ9aUS3pKsnJHZg0rBEpysuV5vzHT5BrtuZdrf5bUIMl6fEeXI4xwpo
+PLsJsA9GgOKJ/p3K+fdadOSKUNxiOcqZWeFGrHjleZDtA4/7zi9VWyCTC0uiwH5v
+67BrWNz6Wp6Nk2vDfWTtiRkYbaewu/sk5i9Tp1iRA4gqTH3RLxOGatJmA4VdI1tH
+2aI29WyFD7lxW+JFI06fq6gYj//G2VN4euZx0kqR/eH0GlBpx/SjRKiFNoAXS6sK
+ZYS2vzj/yiLKOSc770k8GHhsJWEnB+ux63+HokUSbr6EDk1i+P0jTOo88QcWUYYA
+kNeFcCsVgptyiGDYrcViJvLe85gRDqc0ONOgGYGNKRW4cOlBcWWddUypaAiQ4f39
+bC6IGRlkL0MAgDle8Ag64JqGSlMPZysQp0HRhue9/yg5juepO+a546x0cH5usour
+k1B8PF+yj1Ve9XO1aESL06ao9hLjChPN4DD75wXPgcfzc+7wFvv4G22SJ6GUJVdc
+2hdEMJQPIHU45Qre+m7q2lXEvsuTD5jtrvI/ZQFwRc/VIEBU6G+oNb6UlrvQoMKf
+uiKoo/eRXOWDVoXbEhWLzhWNEJ0jmqlTcunl7T9roo0rIpnCFwiFrAjcD4Dsc9WG
+xJHI94Y4/EITz/LDOO1TrK4AQOmxU7/E/d+xV9J6uZuhpY0ingyRE/Jip652od2q
+eCVQBpeyUDuad+GKoDsMLztYD7W6ixEm9j8xkmU1aQG7LkCkrFXwfrdc277TjWCB
+18vL6I9AM3JT+jZTHnsoLbMGYr7DG3/0QuCbBOEVdkDErVXm8f4fEE+aOwT59zD2
+HKDd5CvLvA2LNNADZLFAKooDdQkXk+Otpssh2KY6Oq3FHoXLNPAw5Tzl5xqD7UG2
+R8B1GhGN6uZpF3QdpKdylGHAYVNRF9RnfAoT8TpzlDcVGSfngrR/gtDsqMU0/FIr
+Wj3zgP6BWMmqKTBEiGPU8GkJJE5cE8yW35jlyvJSQPpSCvao8WiG9LErxlbx8qWf
+hDMtuiJHpDwcVXT9jv8kkmiIvT7H37EtMLrCZj9xERpPpwZfO9C8FlXK5/0olBW1
+TWUB+AjttCrwGHJ42L6GKiw8iWHVxioHQ6gaXXT1dX93r6KfRlu6H5dkxr3c8yKi
+CD7S7kQPfqPZ4kuaK2BzRSfVSzUBJuUKz5VZOKkAVsCOxDZPX2uqYFWF309XoFMd
+kVh790gJbqrKhuieQGVbFXtrQLDLeQz6NL/QQyDEk9fOq4+dIHGRCK0Qk88zLO16
+yR/uf9LXsCn7eQZ0RX2BIfPLk4g4PiGvboUfcQjDG8ONdXKw7F+4O3nfMFugDTh8
+SuNi5Ndoz3dMCQja4frLooniwSFvKFNHPS/GB8ehagFFG7iskFljf5IWn+UkIm4u
+OUeZJY5lHS7oFQ63X3NGEUHj6949RRxq3dSK03A2zuoJqTalhXgeeoWZGiOlTujS
+JHngExI8hZLdvtPHt78SUavbURcuuk6BAPXEY62SkwyGZ81vnY0rmPtEVTsM7krK
+utFeU5zb3XSOilxa30akXAQJamQzlcoeS3651sZ7oKAlniaaai01IYOlWI3slvI9
+iPAda1Z30/obDPYp+FjIq5Gxao67/ZxGrWSpTXoWPJ2+M6lszlpvq5m9JlvFhFeb
+QBrZ/lyqCR0+bKkU70HBSLq+FQAZNFMPnVfdXklbZk9guN8dTZIKbHtzDrB113BB
+/ghplNhEuPNREv2ezQoumrRy7CRJ4RfYAOXkgzki+1TxV/dZJI5m15ckUVFMuuSi
+XTKPtm6obl/wTeabiusrvc3OAn4ZKQIoZ41h7A3CdE4mEcpKuhEm8zSnPaYQjv2y
+sNP6mIgIVfUuhukmCikaO6/85mlo+DX1gFknhsc46uvKx7tSwRGmBSTkDIhxE6/5
+gTQQ2d+oUXj4ENRCZYETB/R+HeurH4+4CEvLXbYNEP7fWanexYeJfl2o6iUEQ5HY
+NdISlRwUvA4aTC4kwAVKOKLM6PBjQ2Ot7QymLKhuu3znyxVQL4i1Nm1KHoDtYfLY
+8jAnV/jU0cb2wg0+JE7Lof8R8RH3zej6jDKYmxRlsjq0BYBalqHEoKdfWxbmCUWW
+JhXcn4S4/QsbW44k1Y0HI00mzEikoykjn3oOkXApPa3KEjQFK12QJT9efYGwgjqL
+e1mEMQvT10OWBPWAy9oRkPr2LTL/2gzz240MvmBVee+ZfVnyIPy8Dqxral7GeGcR
+aYM2fUndOUdnr1175KWu39bJw8e+3ryU34UREvxV3ODTentLePIgsEoe/jdXFAHA
+JxlzK66FngD2r18m69BTyH3xGm6gXnj51gKNNq/OwjXo1HSEP0rbfsee7CGqivU5
+9gimkdrrja1TyOlS7ke5lpjxJj0/VRiusmR5TTYuYy0ROMgRtwatf15n9f4cj8SV
+72dySH+Rtp/rDnjCNsCR5Y2wqAZpNUz6oDrSIMK43lrV1I92zFdU8HQo5d7RFBSZ
+Kumwe3OImNQtG+nLSiiFc/aX0hiWv4rlUuXbWhHPD0DKiiA7v8Ex8iP7GxW9Yfs0
+6DYZq26/EbQ9iHYUnI3jaWQSdpwpce0bcQV8zvFOi/b/Wb8J9Dj99D18qdLVHgu5
+Gkur5xFlftUf6B+3qb+LpBOvEj26o/bg+Cv+U71RKQTk8E5P6YqYGzU6rtW4QvEE
+0ZGsvez/+Tpg2dU+yXwFBVjH9zYI8hlc3UThgqlEJ22b6Hbq3bH6eEeaEL4g5m0A
+QQqEZxP7FdF5iixGd388QjC9t1Bud327655EmBi5TX+GNSynmGNZBCcXandWNUk5
+/U2f2S+9kvPHaIRfFD8vA7AV9Z+mYccMuGqA/jhXzgkjgn17ltwDG9GeuNoqSsT1
+x9nr10hHCPxodkauuuUiBcXxE99ZPJ1jMMndAkeysUADldnnvCwuqwrY0cq4JK0J
+ENwkQ5JUQMzpMQnScN1ZDzosMyQq11GP+CMOtW4tzS0UCN2ayk03SP0l6+3DlWOx
+J/+eXdkvn0EjSQWR/rKbSP6KMYzPw5GFA94z1xPopuMWpLq8dZQZ8d5fZTT+8RLB
+k0h0HeiC8Uky87vqHH+S2k+jrCNMi0/gaHwUXmg65rgFo7gRMjX3qlwAOJ3eRsIm
+5f3AfCEVvp2CaFh4v3PidiY/lr6iPAUbDMJXhkN9yIoNJ+QzA5d79LaaCmFCG9Mm
+IfqGrZg1pqeO/vVcnH8RCyBpVY4byA5Nuw0ma1bq91WoY4Ulqc55o57w6x3QUfEH
+rbPtseTc5ItPB3dxUZpjlrJ4+aoXEzhqIiT2zGDvfz1OxhwZ6OVRUN8RkCk/9JCP
+7oIXuxe26+JC0quLuahTn0oS3/qPTJ/S9KDdP2rJWZuRr/J77MUZY0eAqfV6wszo
+W262FEVSjLGSQsJEzPNMz0Ou/MFOYOmE+QwOTRTOqW68v7j+c0876Rlz6npKzCuB
+xpdXcaJvUhq8ns+GAattlFyl5lES7yvmZxWqy071BuUTMSx4NFQezBT8lU/KCCWS
+fT5+hd67hvA87EvIejb68G2Mi5wd8tjeNVvd03y1mfXbwsfZHlv0NxzGb9g911LX
+2f360Ky5FoL30OPaIynaRDYF2r5vs0IWbTxURXRlg/NcKveNWzknaKIqhFaDjn7i
+MSuyDx4ekbij0awuZTjWcgXK9wDTLVQWCzEXpj7jYmmp66xpu9S6X+vgGlqEGSn1
+hTxb1r4kH5rlL3A6HwlxICRXV4c5OH0wEMFQA/7WkNiPLHmx2jIfzxPmdmvJDy+o
+vDPcIEXhEujjvjoSLYgjWLno7075zXFN06AlcaDvWwIZlzZmzOYpOROw7h6TQXC1
+ttHXe/a7aXUd2H8u3KjncNupX/A+r7vZsY9dfw3FhrFWqlw4uMxbxoKm8P+tCh24
+iW585tnvDVRc2L0LEIz+6KhYcdcEMM0D+rEe+CyUfN4bKP4933KzwvB5i6w0Ghjm
+cLlaDgoC3vzoMydAHgMrACyBnEMnUN4ZvgE7fx3LGftka/L0VirvRLzKE/j+7S4D
+ieriGRM+FI1gu67ZgdCiM+vmYaZTXK5MAoYtT+u8Z+GM2cTto1VdkOfB5uDjdu3P
+wA7Y/jysmltOzougFYa29aHiQiaNX2XxqEB1ucJqR468ZGeXwdBc4oLGjx6zPaeS
+0g0kSCTUzjD3xSHcQ3n8qvtCemf0rDI+Roebl+QRZvYF0sHAePvkmJgeBBx7Ogi7
+e2Bfw1LvN8sDaUOQqwKF5EjC35QEnOsReTnjg0iT5q2LJyU3/lw47I6xvtErPerk
+dPn6I5h/X5ug+Oy0hJVNpO1DMSy/W0Mlp8aML3ahU9HDcJKd2IcDJ1qDrHqxsXUd
+JMXxhLyFDH3hFQm+gwDOH4azM3a7SoEoqKfxbNA3QSc5yeuyLfbBkUbNvX79lo9G
+w+xaqX6geoBJijtElkeeSmjQEJeDxzZtlH/8YzEi5k4ktcTRb4tn1EPpf/P9HqBN
+gKEB9f85tAhkySqg5RV+ZmVrjlFFya/IK7qCTSxMWsZwu2rgorRTK1FXB27gg62j
+qB6ed8cVf4OADqoaTeMQ2zhhqXguhko2RVoDKrqIBrDD5sZW6S6hJplo9psz2XJS
++c1UZ+6t9bHqgZmrwIzjNrVFXXs1QIg4MScE7cUUsJJtsf7L266Y0rao9XPwCRV5
+FUvK8l6sLVrg3YBRUNrC89cSmY6G00bc3DkPIm+HmFJoTMzAwIM8NatT3j/4M8qF
+NpoFcQByjCUXiJDJuWaLDKmbQNwjukQ6RZrlPdPf1ffo7zp5B3o91fuilPPqDjck
+h2+utKqBUGjG9h6qYt6ArcoQ9PCdPYsjduuGPqyGQgBIG1HsiJu28Dhc4nibAwrL
+LN8UuIeKCQ66m1qGqbLpfCDcqScDD7im1CNr8DQX0nMtck4vX2XVKBCreJJFxGoO
+liQJT7iIqt9nHFrFmESKPg2Li+s/Vj9V/OpQl1KpfvHuSVdRuKVPVu5k6vFqUHS+
+AZQxHnu8BD8v0/IbPcOJcDH3tP3T29K9yKgwJOstiJffZ0Mu0HqfD+QTFKixv3mm
+uDVXri3UCYGDDJPQEeQCLSf5I4f9m/L4fv7AQVljOjGN+8o2F68VqhQ43h12bw6y
+CjuPQ5F9FaAFvjhH2a6KEQfHGV7JBNsXXznxu7vb3xXI+gehedwYROsgEiHMU9xj
+0vRwCoGnhUMoVCSdh1h7q+8Ju/3VGDJR6PzkF9ajgJyFjEZy5/7bDIojY7Z2RXvh
+TKBqzfTmAZE8NrAIOixUb/5PuRrH0JTILAiThuZ7n1XMKcm9rz2Zbm7xsarzOv2h
+OfR0EcYnW/tBTGO5MTHmKWl/lmsQTrPQJp7eQPntsi0biM/wS/lWFpzpl8W3aEsA
+w29/IAbLQaROfJdi9WdbNq4pzKj4AOVFaEMFOvp0BKOxabiPVrAyW9YyyDLn3+PK
+SzthO+qNkG2h3/q0zmyJyVQaMvny+DsUkB3Z9EK+bM2QLKmrD/oSgpDFiI4oDY6m
+4143q+vW6YVCCV6XJmGo41wwoY32uP0PnqLCWUe/qUEckJiH4ZayryF/TpOB+VDr
+anzo/PMYvUOko3qNuBSzBYle1oeARTizD/sA3c4Q+WPM30BcH7NxvPW2NVSvyc1H
+s4gvXigBQDxqENA/MPvtgFdrQNBHNjHcVRhnG+ziBRUzNOCZ5IjI9R6sjR/4lyOr
+h3/4Bm0bTvVVnLIaiYZWA8UBSef/2RLUjKMMl0IK2BYDyBwXSchPqULXud/OPtTL
+MtcUNNgTGHGexEwnbBu8TacFrSFQMnTrOP2djyOmzniNHLYOXOLJt5rYR0qjd6+r
+ey61eTNAlg4O2MJITT7f1yAwHc4Oyr0KmUeMKdhrU93i23Qx/JdqhUvaIKeDldT9
+2r/KH5OPEelX3hwSWoC8jeyhhFM2MwWvRtwc0ojwnmo4M0gU8C5KtJd9DqaGmyUu
+walDEXVlQdlviB/oOPB2Tn4mYmV/1fYWJ5S6V2nIBst7UbDcjZCc119F2wgr9m2B
+eqAGDR3WdmvfvOyKK06BCKhVSVlSrtya6w3xbn9VJVN7SGVuI4P+Pbbozya0kvuc
+IVSum44tEcOWL/Dl0MrPWtHEgBDAr51upNvHXwiIzG22MkVY2ss3kOwWMpEe2HMj
+PLgHgsyx92DCJNyvDMszjyOk0uD2UEGPxmkY4BMcaeisFlnRajyBcfjLwEGuhKq/
+g/dBnn+9x7cWk/p6iM5V5XnWFWRsOUKRqTNbuXf8AUNF1orwWQTgvuBaetkgJ1UY
+5sBreSD6sfutOGd9iLMmU9BtBtWmM9y/wP8sVfYKKmM87is9LkGm8ZBgHX5nu8gQ
+gS6N5Yi3ZMFcwBqgBCRI43ocpjI4+mjGsa0/5jVAqrxzea6KaZBRm3ZxCe7vpmCM
+x5+V6f1bhOqBRFqPANN6sQlzrJ08FkHvovClJMI9UZTc0vVl+6fjq96zMDII8lyQ
+t5fnp+gySYErq8IvNWrOUK8aaF0umVg7vCguGN1TzAaOLUNA5efJxeSBDuKyq1j4
+lHCKpH9m567xcLH7/cwxTYHtvN1QgfqNcvcJOS27G9JUvBqczx24vyuEI39rZGeG
+1QSn+MmjMg9cZ99OGyz/XLsVrzJn/80YYOpQsOx7krmxVqAosjKGJ7cWjFHF9piH
+WQkrhGgzf2eDkhVoY+epzlt38LnhyhBGxyZUvwJXmeIDDqV+d+LCBaVAGCDUKVee
+H6dSSR3vmOTt/aYVVpsYLZcFTZ/km/9dmDNduOrFroeumgAqNm0CRnTjR9nTKEd8
+3hjhZhzRZpB4UibImK+8ln7fPnDbjZOFYI1S59kyT4gAnNRMWSEv6dHYqTludfcE
+NJ2jYCc8JDwadOSvxL6YeaQ+1O5U/MZhxF1eG9crUa0D2eAxI3QivxCdl+dWExgO
+VQj7H28NYV8wW9LBRnFvhb+5vOf9nWPGonRbg/2H5liMi8U1owR/koIA87dX+0tL
+nfR0lcucoT0+6ju65OCVAO5busv9A5sMpVUw9psghQN07nIETosPxzNmycdcsOK8
+sag5oaYzBUqLMA2WoapOiAijFV9Szca3o9WJoPnhUc96fDYMBgPbIuwJPuCgtnL5
+ssZQ1ettUd7Tp5dVCyGi6TfzoubOFogVGirz+7j6IRereAbqwOvgEaKRZ33on/gA
+FFfDtQZx/9cO7z+kyZuKZyR5mCfyQYJ8CNzdYPRdGPLbcGriOZGPCGetwtqjlFjt
+oLpS7vusbyfQuFR8pi5Ign9yHDZ1r5vwz/xAHbsCZFwQEpA8nojvx5R/047EMfQJ
+v3fKfNK6BkUVqSBe9vsTsSecibt+R1/XmI6R1pdGax5YmP0Gciy1Ukmv7NtGUPza
+MvYJ6rje4PjQJ9QNbpIkLA/8kvOh2fgdz7ny24nVhh6xlr2QNelOpGbcRBaGccLO
+772G1gMmxiUtW7lukO8qM98zPluuVpePbBevQOzRUFavJ+vJxXtJKkMPEv++cyo8
+7wMvaugbUBw7ZZ1fvZkyzWc2PyQTLmgwX2+M/H7631sxCaZVxtEMYAqEvdYJ++2v
+cf0Mdu0M0qwtwPcfYCi2PhKhKWnZIf6kJjsg8iq6Bf5SMQ8JxJwRJESegSkKNm59
+htpzJafVvye1l3+ilgXJoasy7AJ028Aa5wKdlC/AeWeL787XTKy/dUxnaFI2D4Os
+Ahk4FB64aHBPr2qVsZRMWNU8pRxikwnTzTX0MXW8Ge4tgiQucytwbWZWxZP53Srd
+2sLHxe6LgY+kVqeCOwh2GtGzItNtjsB8hjW9lN8zCvldpZnYor/6DoedJ6SMMwT1
+rQxB8tagq1dOiMXdlwnVPpstKSJofTLgiXKNZaCLHoConGNCO0cz4vefuhdtzuPU
+v/Rf+7cJmXFWru5YxfQFI1vbG9vqrDPoAC58gCC9BzAvzuO5PDoTU2pcTB/9zqJ9
+t4yetdLLpFyxd4MTiXoUEjzlNsmyMZ4HIpAaGluloUPyz9fx1wJpPTFuX05KS8FR
+BaxtLkdVdndBBE+CGqfRrr2Z4BXTPBXyrt5bDkbvMh5AZw89uYOu9pmI6dh+jzGw
+o3B3qC0QNhR94uaay8v0oeXhvKji11KgoYRuBLTAwKpcxiFue3ePxIbq6F68tL6Z
+rSvoQXGcDhjgDiYa6haqzxo1y4RgxybwuUP4UOWD3nWklNzkxnz9RiLnwUHRt36j
+oMCB1C3JFjY6pNPUFuNmHDiV060jjZmk/A0R92/JNiUv87dZ/7K46r88H81nv4Se
+Za/Td5p1DtKRpc3mT6R/3XRvrIy3g5L09BUGCPuW1IpKu6zOAt07QrwX/WAvgf40
+zsWQUgZ0gaMkZkMr2QgIcgzQOiMhCIcylxu1ky7jgnhhCq7Xny24jQ4ZFj/VtwUW
+P5TopAUtSdmzNgnEbG2JNsCumcAIpNAggEeDpVvRq1e+yYIkYvHrv4qwhl6UJmLA
+cyh6BQ0kaQ16v++Rt2PYz7D4VZzXfXULHUhTgbm5Jwx5v1GEWohfQ2IjvSs043DV
+SRi094WAR9NCN23suwQ22yoYNP0z83Wkej43c8OfapreA8Ndiy2QSQXD90n05hI5
+PWMQ1zZz+wVWSGLIoTj2qEZtnpSUUw6sLqVsDx2vv+g86ubbhzHhfC5yIJs5HFxB
+u6/rPtqdHm8Nvuu1Lb7AQsS2v9E2GBR9akzm8L8KsBcvIqbeKZi22zbix8A1gA8e
+iNNmh0c0jBNJin9GiFMy1ij8+P4CJKFHHlcOJuzpW0RZY+f9wG3tKc1zwao8G2vV
+e8CU9Umvccoya/HAMHvlDPhQ69hS0m4aA7GwOwpnX0uss7e7rGeohLYxdvQ8CuO+
+vdxpnIY65HncnX1tBWiovlAs/3KAR1J/pHKqU62v9DLIvWjKeBHWjOHlKqHFQ7k/
+7cFcs4kF7bxqP1SVf3Tcp8NN+uvYdtkEEOfi3AaoVsZcaSCspHzgTlO4FFCH3mGM
+Hq7BPsfYxjg5VVaIkYGz4ghfc9v9n+G+NSw0uxmZBzbmzGSgKHAebflHHh6aLnSJ
+0h5JhY4WVQFRDtasn3j0yaFQWGGEzIknIYzaz5mN4ArTvpkXMpRlsAJYxAZeXEh/
+H4rjPdNIEzKUeNbdRMJfLwh2awQ/3R7rYLwQjP9oxP3XQxXBhxEz0drYj/BN9M+o
+QsD1ilS3ijiiOFiVdZyAQBlhLOCmHToiILvMBh8JOCXI1sSm1kYhnwTe4R3D8jwK
+BjhhabQ/agpfheNsfFZ09BrB4j8B6OV8cwD7NjTJilYD+4WqJquvjaluEtmJ4cMi
+9JFpTgZAFpOQcglwdl+zSaJ/A+ZSRbmkN0DfpoExE1GIrR/hIsOf46xwB1WHxrO6
+tyIF85ehBqOuBdFtyzQp/lQ9t0xuy2ScijfxliwWGyuiYBrJGi3ptoDJ+SZ6mZKw
+umV1tL/3sOXO4p5sIzW/S19UMQHfrXHUAofDFoZQqizv+9vR1hRKyWWggLD6C62r
+5ZQ5IKfgMI9Pq5LzMc40cwl9GFCviJyZVTxp5aIQbIt8G2DiMKflhHtDM4NWS9f4
+VrS58h9bJi7cgWOcnST39t3ZaXCR7XMD1PGgX20ouw9QQ1ffWDzjCK3dHWWXxGei
+VURLV+IPDsG3p70eJjJjegHtTrGD0OyavZ/F5lv6tKEDoZmHJpMXdP7hUeiJeW2v
+zL6+1Z2brk1S+Qhtmqrct94lHV5tKCAUo/T5tOBef105MTFaEbp7f2I5Mqb4l9nd
+N1hNqby2X7nrfVf3wjq56hExTwkNuSMxza56KLsZrjA9nOMszblza0pV9uvzZEL/
+wM9mY49Eu8ZyTHSxXss8lJCRrm5Fl1TZFy4blB0klHOKjnqx33RJooWFgU16sP3W
+7uMf50qgxqGFBoqZOh/HQ4yB6dGjPzDTLQjesbxGZXMOYoSwbcVI/sZUHBcIcjDr
+002nDJmivTZtrqXz6kKHo5Z9fCmZ/U74CyjzFoR5PSO4E2wsWDPWqs2MPb6JZMM9
+kDRgE+MAeQ+QVwvij1N9bI4OqsnRW/JIqBicY3A54chbkV7YllcLWBExgL0iLtco
+muDLZNSwSubE+mnVEyB95GJ+XwNfL8ULsl3hlsN4vcbYNbWecXnqE7cm4RRb+M31
+mmx1+ZHqGsLOf1iYgSWp6Twbu3WlhOpZ3+qHCzOpwh2kvNZyMm7LDNhX5u/jOets
+oNTFL5zt63g4e180B69vRlSBDHQe5BDX5UYGOUGvLsZ7v/CXN1TUY8jMiOfoffMS
+QJivsUMIy4zidcBwmxjqlyLJmlNw/vv2eL8JIeDC2yEaSHEN9ch4Rhyhg/F7ni3s
+zTgOVSFmgRUKhz8zaypDtNd4BdUacYibCN6g3haC7+LoxB4j227+9dK56uZbFgeg
+hlL/hzhF8wGXxpjeAKALx7pmSPjzhEWtPCztHGVtIWdy5D8SxzPsV+pdk4KCRTnw
+oouHOpYoKS0FE7uHBSQs6xgzT9njwxlhm7eyx+Dc6WOXRpfnHqhnL6C6t3wGJZWO
+U6Imba5bZ1P9HQ2mgoAMLpSbq3FT4kr3iFfr6hloxFFteZp+Uja5kuz8kPeTDhkV
+3w9ZLDYx4UHLF5zc46vMuz+tfXEI8OYBiT+V9tz4MT9+E72wbAKCB1XxdXQ2O0MT
+gHjF4s3OAzN8ycv3g6SSHgjB0dx2cjWt9mJpSwqaIX9c5KuNoohD62iSh/FeND2Q
+rNhxCTaO2tyoL8y6yKDFcdXDpkYuIYjAfnfnk0ZA2ak2B8BVL/6ukC9rGaf2bKfR
+xofxzmH7vuBL/wgcbisGbsKev+iF8kMryiBiWiv8shRHpU4UMyI9JpHli5rPABcG
+4Ri5VGuWU8ivgIJaQpCCri0WMM2CxdAzTiYTdV5rKPybD8m7iBwvtzENHSh1YXpj
+Bs5kuiP9zUo8ItDi4lcSWF9gkOdmlHahOI9C0ojYC9G/3ehmrNJE6dnuEoYsoiGS
+WA5n3AMIX9vO99P5nug1juNttMq9GAmx4eBCMagGhVsPNJVFwThCHsnv7Nr8nIJP
+OqPpUqiZEPwLl/2y50rDubiOfFyoDMKGnTY726dnXvtiwmdONeU47A2IC1r6tbO5
+QDkzyfF7XIeVgV6frZ9MvcN5x4n0ib/Ls3LFGoW8AtmdHzrs/sIqKFsBANKfZEP9
++X4kDaHSAwsvIJVxV8sYMMG68pMXrgzPWGbxgsy8kqg9WuI5Jf+f4wvUYT9wfbJ4
+dE+K4+jIMUsVoFH0In9Fih11Hq/IjYSn8FuVkGCWJ8Y++mTIV595pjcgLZ998SGF
+OfGxcVeXuts1ucFhINBms9jDE/JiDaRWEZ8sg2ry9fMQz+QPEUWCwnunJin4NckZ
+wo7dcZYjgZdSYdTIpG60noHfJ6d6cdzwn+aANy2lcfbHGw2YpQCNEOmbWpdLG+O2
+3Rj3Y1olunSnQACK0zp6AtQVQk7jty/vx22fJDy0UPQgzWvWgAWpw0uSDc2ehWRJ
+i+kWqZq/J1fdKcdwxbF+jRaMxHUsuaMtVSGqRU7H4uhdM3EN4KU0djuvMOo6xzDY
+ShgBfkLsNwSgN9Ld5RiC4ATcROeoBP6lTqoX4HMXp1OORul+xyWA117u6ElRewkO
+hxiMVcmM+Kqvhddv0IjUd37BFIrfOE3ryRVh2UK7ucOkFYlods/wFOPjirlnDK5y
+ZyVWvBiEf42QjHfX+Bk+RIDdTnldz7ZttVUNCrTSM36nNeF/bs5rq+IzVrgIV4SN
+RkcQd9DbW0mxG1Mvk+ebkDnrplAR8hlxtuVYqz1Bd+7ZpoKkh6NPRvmuQr7DW66I
+5VbaIrFxLHpkAg+Y9Y7ZAxREbYGl1Fn/9qcNA24/TThyhemKTkl7XDDJdEtJu9Lj
+KChmMzvd9zoPMxjudNDeN2PxqI3HKVtZ1Cr6oJPM5+rO8SgB/p8RGHo45Kd1JHhG
++TeLtyAd9+pi7QrrF7yQDvgIvmzdCmRWp1QHGSpMmvymqF+JB9hZ8HN0JYZqxAyP
+AxnDF8Au+jVrX5fCBqTRKB5r6JoVmobmRgL+Z07Jm8t8YiHV2MxadG8Fx7mhGGL9
+MPC3AQ8oaNzyqHkT8v9YkNLaROmZB7mjcnDlF+C2BanEjQvFAj8PWocWpN1CuYzK
+ASa/6X3B/Gc9PootCmKROD0JKpSkfgHNFZu/VXffqt0SrGMaqscVJ2qY7btWLKt7
+NpwxvFXtU+WnlVD3EfiquUQWSWvv4fEaJiTlKVmUyHKxhtq6SgL5B3DqCvMva+qm
+0zCc8my5w3Y1SDhHrbDp618v3u0Yb8fnWMI44sz1+RRo1Pi2T2DnGG8NESfO7/yj
+ftudvnUZmPlIk4p0hTGu1KFnmVG8UC/6DOMohDgci8EIe4uaE47EgOBKyG+QfEoX
+iX7CGOaKU0+A1I9WFTWLTVEh/iVQD+iqWEcoc5QXOdkwCsLn1EVIY3a48LHhMg9y
+bmBKeZqgEE2ywPH/aLOTTXeMvsmSUfeI85+06xN1sPt0Bh4VAqMqomWvKuE5UE2u
+cXyNvdVftp8qmiJ/PDrHjiLIK5usIRxnXbi28HAPTfj0mqCcsRE5i6G3cI62JSD6
+askrqezv7y63Qlx+5nl7T7Z4ukryphrxFS7L18OlwlaZqVxPIuMtezedob34QoWK
+n35rv2uwSe/5PUNOF0KTVxfIDkkVICjKnaTyFk1Stm6n/LB/r/iHnQ/QmQbXtqpU
+NYznbDF8Vjod4+ux9h+bDKQ4JhZr+ZirQg==
+=XxLG
+-----END PGP MESSAGE-----
diff --git a/privdata/privdata.gpg b/privdata/privdata.gpg
deleted file mode 100644
index 7adbfa93..00000000
--- a/privdata/privdata.gpg
+++ /dev/null
@@ -1,19 +0,0 @@
------BEGIN PGP MESSAGE-----
-Version: GnuPG v1
-
-hQIMA7ODiaEXBlRZAQ/+PM/KTUaI4xdM+eDaiund1opYfCFjcwPoXcvj56pahV4D
-3P7EYYhd1tAYaj4dGiPPNCN6bp6Azajhggu2CEm0VBCGGKIxo5p20rlITwVCgVHa
-Y9JRhh6A8t0e34fSOFFfaBBRDF377Y6sWuJ/deo3h/OhmJyOwSBVANwqBdQVOSza
-LLnsZ2utkHgnXjS1hb54IglG0MAgU3ynYCDg6H+v1ZJ/qHH1hK5FINYVQ7cs60ZR
-S1VdJObt11jHr72C2804bJpWWK0//cE3BV5wzugRopfBorhdoPlqaQ81aqD3TkYa
-1nthyjA/E9TnU15M8WTkgfDRFYa/mcrvTLNd+MIRSV0wwIy0kBvRvQYBLV276Sdb
-cr1nk91q2KwwnDoymlZyKN0v2Ax9lq16QKrW+hLHFlnOs7OjzUGNvaog/Q9P25Yu
-Q+/WkP9ToN6UvkGFV10ItL8cttt9W8kFMFIzTXLX65f2s14+pKBX1M0xhDVhEEJp
-BscOW/gIcOoINUBbQqTSMMjUV6bIxmyNXKw2kTwvtqtbd+fRN6kBMYVeJ6JQK2gx
-ANXVd+Xs1r1dOGnQ469mUX1gkc4dByUa1eI8QQLoFPKpTkmpJngjzD7izhyW+v2m
-GWPHHdS2F1xhzwLWxsh8fZ5NHkUTnIZqKfMacLWqKY7omUNNFPd9/W4c96M0D5bS
-fgGcrlNnNQLNdCKysU9jdc4Y3bEVoGA9mSUhhzBpyC0XAo/7dm34rBlXWHl6v8jx
-hr9vdV/g6QxCr8qjnndsTqCd2hwk/+1IXoKctzxWFYtv8fxv7UNDir9sCtovLamH
-fyTU0AeA4ignXssxQH5PHbQCaUcVO12lp7RAR6vuvg==
-=nkRo
------END PGP MESSAGE-----
diff --git a/propellor.1 b/propellor.1
deleted file mode 100644
index 3ee3bf4a..00000000
--- a/propellor.1
+++ /dev/null
@@ -1,15 +0,0 @@
-.\" -*- nroff -*-
-.TH propellor 1 "Commands"
-.SH NAME
-propellor \- property-based host configuration management in haskell
-.SH SYNOPSIS
-.B propellor [options] host
-.SH DESCRIPTION
-.I propellor
-is a property-based host configuration management program written
-and configured in haskell.
-.PP
-The first time you run propellor, it will set up a ~/.propellor/
-repository. Edit ~/.propellor/config.hs to configure it.
-.SH AUTHOR
-Joey Hess <joey@kitenet.net>
diff --git a/propellor.cabal b/propellor.cabal
index a6d00a03..38ed32e7 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,8 +1,8 @@
Name: propellor
-Version: 0.9.2
-Cabal-Version: >= 1.6
-License: BSD3
-Maintainer: Joey Hess <joey@kitenet.net>
+Version: 3.0.5
+Cabal-Version: >= 1.8
+License: BSD2
+Maintainer: Joey Hess <id@joeyh.name>
Author: Joey Hess
Stability: Stable
Copyright: 2014 Joey Hess
@@ -16,111 +16,188 @@ Extra-Source-Files:
CHANGELOG
Makefile
config-simple.hs
- config-joey.hs
+ config-freebsd.hs
+ joeyconfig.hs
config.hs
- propellor.1
+ contrib/post-merge-hook
+ stack.yaml
debian/changelog
- debian/README.Debian
debian/compat
debian/control
debian/copyright
debian/rules
+ debian/lintian-overrides
Synopsis: property-based host configuration management in haskell
Description:
- Propellor enures that the system it's run in satisfies a list of
+ Propellor ensures that the system it's run in satisfies a list of
properties, taking action as necessary when a property is not yet met.
.
It is configured using haskell.
Executable propellor
Main-Is: wrapper.hs
- GHC-Options: -Wall -threaded -O0
- Hs-Source-Dirs: src
- Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
- IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
- containers, network, async, time, QuickCheck, mtl,
- MonadCatchIO-transformers
-
- if (! os(windows))
- Build-Depends: unix
+ GHC-Options: -threaded -Wall -fno-warn-tabs -O0
+ Extensions: TypeOperators
+ Hs-Source-Dirs: src
+ Build-Depends:
+ -- propellor needs to support the ghc shipped in Debian stable,
+ -- and also only depends on packages in Debian stable.
+ base >= 4.5, base < 5,
+ MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
+ unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
+ time, mtl, transformers, exceptions (>= 0.6), stm, text
+ Other-Modules:
+ Propellor.DotDir
Executable propellor-config
Main-Is: config.hs
- GHC-Options: -Wall -threaded -O0
- Hs-Source-Dirs: src
- Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
- IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
- containers, network, async, time, QuickCheck, mtl,
- MonadCatchIO-transformers
-
- if (! os(windows))
- Build-Depends: unix
+ GHC-Options: -threaded -Wall -fno-warn-tabs -O0
+ Extensions: TypeOperators
+ Hs-Source-Dirs: src
+ Build-Depends:
+ base >= 4.5, base < 5,
+ MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
+ unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
+ time, mtl, transformers, exceptions (>= 0.6), stm, text
Library
- GHC-Options: -Wall -O0
- Hs-Source-Dirs: src
- Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
- IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
- containers, network, async, time, QuickCheck, mtl,
- MonadCatchIO-transformers
-
- if (! os(windows))
- Build-Depends: unix
+ GHC-Options: -Wall -fno-warn-tabs -O0
+ Extensions: TypeOperators
+ Hs-Source-Dirs: src
+ Build-Depends:
+ base >= 4.5, base < 5,
+ MissingH, directory, filepath, IfElse, process, bytestring, hslogger,
+ unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,
+ time, mtl, transformers, exceptions (>= 0.6), stm, text
Exposed-Modules:
Propellor
+ Propellor.Base
+ Propellor.Location
Propellor.Property
+ Propellor.Property.Aiccu
Propellor.Property.Apache
Propellor.Property.Apt
+ Propellor.Property.Apt.PPA
+ Propellor.Property.Attic
+ Propellor.Property.Borg
+ Propellor.Property.Ccache
Propellor.Property.Cmd
+ Propellor.Property.Concurrent
+ Propellor.Property.Conductor
Propellor.Property.Hostname
+ Propellor.Property.Chroot
+ Propellor.Property.ConfFile
Propellor.Property.Cron
+ Propellor.Property.DebianMirror
+ Propellor.Property.Debootstrap
+ Propellor.Property.DiskImage
+ Propellor.Property.DiskImage.PartSpec
Propellor.Property.Dns
+ Propellor.Property.DnsSec
Propellor.Property.Docker
+ Propellor.Property.Fail2Ban
Propellor.Property.File
Propellor.Property.Firewall
+ Propellor.Property.FreeBSD
+ Propellor.Property.FreeBSD.Pkg
+ Propellor.Property.FreeBSD.Poudriere
+ Propellor.Property.Fstab
Propellor.Property.Git
Propellor.Property.Gpg
+ Propellor.Property.Group
Propellor.Property.Grub
+ Propellor.Property.Journald
+ Propellor.Property.Kerberos
+ Propellor.Property.LetsEncrypt
+ Propellor.Property.List
+ Propellor.Property.LightDM
+ Propellor.Property.Locale
+ Propellor.Property.Logcheck
+ Propellor.Property.Mount
Propellor.Property.Network
Propellor.Property.Nginx
Propellor.Property.Obnam
Propellor.Property.OpenId
+ Propellor.Property.OS
+ Propellor.Property.Parted
+ Propellor.Property.Partition
Propellor.Property.Postfix
+ Propellor.Property.PropellorRepo
+ Propellor.Property.Prosody
Propellor.Property.Reboot
+ Propellor.Property.Rsync
+ Propellor.Property.Sbuild
Propellor.Property.Scheduled
+ Propellor.Property.Schroot
Propellor.Property.Service
Propellor.Property.Ssh
Propellor.Property.Sudo
+ Propellor.Property.Systemd
+ Propellor.Property.Systemd.Core
Propellor.Property.Tor
+ Propellor.Property.Unbound
Propellor.Property.User
+ Propellor.Property.Uwsgi
+ Propellor.Property.ZFS
+ Propellor.Property.ZFS.Process
+ Propellor.Property.ZFS.Properties
Propellor.Property.HostingProvider.CloudAtCost
Propellor.Property.HostingProvider.DigitalOcean
Propellor.Property.HostingProvider.Linode
Propellor.Property.SiteSpecific.GitHome
Propellor.Property.SiteSpecific.JoeySites
Propellor.Property.SiteSpecific.GitAnnexBuilder
+ Propellor.Property.SiteSpecific.Branchable
+ Propellor.Property.SiteSpecific.IABak
+ Propellor.PropAccum
+ Propellor.Utilities
+ Propellor.CmdLine
+ Propellor.Container
Propellor.Info
Propellor.Message
+ Propellor.Debug
Propellor.PrivData
Propellor.Engine
+ Propellor.EnsureProperty
Propellor.Exception
Propellor.Types
- Propellor.Types.OS
+ Propellor.Types.Core
+ Propellor.Types.Chroot
+ Propellor.Types.CmdLine
+ Propellor.Types.Container
+ Propellor.Types.Docker
Propellor.Types.Dns
+ Propellor.Types.Empty
+ Propellor.Types.Info
+ Propellor.Types.MetaTypes
+ Propellor.Types.OS
Propellor.Types.PrivData
+ Propellor.Types.Result
+ Propellor.Types.ResultCheck
+ Propellor.Types.Singletons
+ Propellor.Types.ZFS
Other-Modules:
- Propellor.Types.Info
- Propellor.CmdLine
- Propellor.SimpleSh
- Propellor.Property.Docker.Shim
+ Propellor.Bootstrap
+ Propellor.Git
+ Propellor.Git.Config
+ Propellor.Git.VerifiedBranch
+ Propellor.Gpg
+ Propellor.Spin
+ Propellor.Ssh
+ Propellor.PrivData.Paths
+ Propellor.Protocol
+ Propellor.Shim
+ Propellor.Property.Chroot.Util
Utility.Applicative
Utility.Data
+ Utility.DataUnits
Utility.Directory
Utility.Env
Utility.Exception
Utility.FileMode
Utility.FileSystemEncoding
+ Utility.HumanNumber
Utility.LinuxMkLibs
Utility.Misc
Utility.Monad
@@ -128,14 +205,19 @@ Library
Utility.PartialPrelude
Utility.PosixFiles
Utility.Process
+ Utility.Process.Shim
+ Utility.Process.NonConcurrent
Utility.SafeCommand
Utility.Scheduled
+ Utility.SystemDirectory
Utility.Table
Utility.ThreadScheduler
Utility.Tmp
Utility.UserInfo
- Utility.QuickCheck
+ System.Console.Concurrent
+ System.Console.Concurrent.Internal
+ System.Process.Concurrent
source-repository head
type: git
- location: git://git.kitenet.net/propellor.git
+ location: git://git.joeyh.name/propellor.git
diff --git a/src/Propellor.hs b/src/Propellor.hs
index c0ef14f4..a371ea44 100644
--- a/src/Propellor.hs
+++ b/src/Propellor.hs
@@ -1,15 +1,12 @@
-{-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
--- | Pulls in lots of useful modules for building and using Properties.
---
--- When propellor runs on a Host, it ensures that its list of Properties
--- is satisfied, taking action as necessary when a Property is not
+-- | When propellor runs on a Host, it ensures that its Properties
+-- are satisfied, taking action as necessary when a Property is not
-- currently satisfied.
--
-- A simple propellor program example:
--
-- > import Propellor
--- > import Propellor.CmdLine
-- > import qualified Propellor.Property.File as File
-- > import qualified Propellor.Property.Apt as Apt
-- >
@@ -17,61 +14,63 @@
-- > main = defaultMain hosts
-- >
-- > hosts :: [Host]
--- > hosts =
--- > [ host "example.com"
+-- > hosts = [example]
+-- >
+-- > example :: Host
+-- > example = host "example.com" $ props
-- > & Apt.installed ["mydaemon"]
-- > & "/etc/mydaemon.conf" `File.containsLine` "secure=1"
-- > `onChange` cmdProperty "service" ["mydaemon", "restart"]
-- > ! Apt.installed ["unwantedpackage"]
--- > ]
--
-- See config.hs for a more complete example, and clone Propellor's
-- git repository for a deployable system using Propellor:
--- git clone <git://git.kitenet.net/propellor>
+-- git clone <git://git.joeyh.name/propellor>
module Propellor (
- module Propellor.Types
+ -- * Core data types
+ Host(..)
+ , Property
+ , RevertableProperty
+ , module Propellor.Types
+ -- * Config file
+ , defaultMain
+ , host
+ , (&)
+ , (!)
+ -- * Propertries
+ -- | Properties are often combined together in your propellor
+ -- configuration. For example:
+ --
+ -- > "/etc/foo/config" `File.containsLine` "bar=1"
+ -- > `requires` File.dirExists "/etc/foo"
+ , requires
+ , before
+ , onChange
+ , describe
, module Propellor.Property
+ -- | Everything you need to build your own properties,
+ -- and useful property combinators
, module Propellor.Property.Cmd
+ -- | Properties to run shell commands
, module Propellor.Info
- , module Propellor.PrivData
- , module Propellor.Engine
- , module Propellor.Exception
- , module Propellor.Message
- , localdir
+ -- | Properties that set `Info`
+ , module Propellor.Property.List
+ -- | Combining a list of properties into a single property
+ , module Propellor.Types.PrivData
+ -- | Private data access for properties
, module X
) where
import Propellor.Types
+import Propellor.CmdLine (defaultMain)
import Propellor.Property
-import Propellor.Engine
+import Propellor.Property.List
import Propellor.Property.Cmd
-import Propellor.PrivData
-import Propellor.Message
-import Propellor.Exception
+import Propellor.Types.PrivData
import Propellor.Info
+import Propellor.PropAccum
-import Utility.PartialPrelude as X
-import Utility.Process as X
-import Utility.Exception as X
-import Utility.Env as X
-import Utility.Directory as X
-import Utility.Tmp as X
-import Utility.Monad as X
-import Utility.Misc as X
-
-import System.Directory as X
-import System.IO as X
-import System.FilePath as X
-import Data.Maybe as X
-import Data.Either as X
-import Control.Applicative as X
-import Control.Monad as X
import Data.Monoid as X
-import Control.Monad.IfElse as X
-import "mtl" Control.Monad.Reader as X
-
--- | This is where propellor installs itself when deploying a host.
-localdir :: FilePath
-localdir = "/usr/local/propellor"
+import Data.String as X (fromString)
diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs
new file mode 100644
index 00000000..ae75589f
--- /dev/null
+++ b/src/Propellor/Base.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE PackageImports #-}
+
+-- | Pulls in lots of useful modules for building and using Properties.
+
+module Propellor.Base (
+ -- * Propellor modules
+ module Propellor.Types
+ , module Propellor.Property
+ , module Propellor.Property.Cmd
+ , module Propellor.Property.List
+ , module Propellor.Types.PrivData
+ , module Propellor.PropAccum
+ , module Propellor.Info
+ , module Propellor.PrivData
+ , module Propellor.Engine
+ , module Propellor.Exception
+ , module Propellor.Message
+ , module Propellor.Debug
+ , module Propellor.Location
+ , module Propellor.Utilities
+
+ -- * System modules
+ , module Utility.SystemDirectory
+ , module System.IO
+ , module System.FilePath
+ , module Data.Maybe
+ , module Data.Either
+ , module Control.Applicative
+ , module Control.Monad
+ , module Data.Monoid
+ , module Control.Monad.IfElse
+ , module Control.Monad.Reader
+) where
+
+import Propellor.Types
+import Propellor.Property
+import Propellor.Engine
+import Propellor.Property.List
+import Propellor.Property.Cmd
+import Propellor.PrivData
+import Propellor.Types.PrivData
+import Propellor.Message
+import Propellor.Debug
+import Propellor.Exception
+import Propellor.Info
+import Propellor.PropAccum
+import Propellor.Location
+import Propellor.Utilities
+
+import Utility.SystemDirectory
+import System.IO
+import System.FilePath
+import Data.Maybe
+import Data.Either
+import Control.Applicative
+import Control.Monad
+import Data.Monoid
+import Control.Monad.IfElse
+import "mtl" Control.Monad.Reader
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
new file mode 100644
index 00000000..29175a67
--- /dev/null
+++ b/src/Propellor/Bootstrap.hs
@@ -0,0 +1,229 @@
+module Propellor.Bootstrap (
+ bootstrapPropellorCommand,
+ checkBinaryCommand,
+ installGitCommand,
+ buildPropellor,
+) where
+
+import Propellor.Base
+import Propellor.Types.Info
+import Propellor.Git.Config
+
+import System.Posix.Files
+import Data.List
+
+type ShellCommand = String
+
+-- Shell command line to ensure propellor is bootstrapped and ready to run.
+-- Should be run inside the propellor config dir, and will install
+-- all necessary build dependencies and build propellor.
+bootstrapPropellorCommand :: Maybe System -> ShellCommand
+bootstrapPropellorCommand msys = checkDepsCommand msys ++
+ "&& if ! test -x ./propellor; then "
+ ++ buildCommand ++
+ "; fi;" ++ checkBinaryCommand
+
+-- Use propellor --check to detect if the local propellor binary has
+-- stopped working (eg due to library changes), and must be rebuilt.
+checkBinaryCommand :: ShellCommand
+checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check; then " ++ go ++ "; fi"
+ where
+ go = intercalate " && "
+ [ "cabal clean"
+ , buildCommand
+ ]
+
+buildCommand :: ShellCommand
+buildCommand = intercalate " && "
+ [ "cabal configure"
+ , "cabal build propellor-config"
+ , "ln -sf dist/build/propellor-config/propellor-config propellor"
+ ]
+
+-- Run cabal configure to check if all dependencies are installed;
+-- if not, run the depsCommand.
+checkDepsCommand :: Maybe System -> ShellCommand
+checkDepsCommand sys = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand sys ++ "; fi"
+
+-- Install build dependencies of propellor.
+--
+-- First, try to install ghc, cabal, gnupg, and all haskell libraries that
+-- propellor uses from OS packages.
+--
+-- Some packages may not be available in some versions of Debian
+-- (eg, Debian wheezy lacks async), or propellor may need a newer version.
+-- So, as a second step, cabal is used to install all dependencies.
+--
+-- Note: May succeed and leave some deps not installed.
+depsCommand :: Maybe System -> ShellCommand
+depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ " ) || true"
+ where
+ osinstall = case msys of
+ Just (System (FreeBSD _) _) -> map pkginstall fbsddeps
+ Just (System (Debian _) _) -> useapt
+ Just (System (Buntish _) _) -> useapt
+ -- assume a debian derived system when not specified
+ Nothing -> useapt
+
+ useapt = "apt-get update" : map aptinstall debdeps
+
+ cabalinstall =
+ [ "cabal update"
+ , "cabal install --only-dependencies"
+ ]
+
+ aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
+ pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
+
+ -- This is the same deps listed in debian/control.
+ debdeps =
+ [ "gnupg"
+ , "ghc"
+ , "cabal-install"
+ , "libghc-async-dev"
+ , "libghc-missingh-dev"
+ , "libghc-hslogger-dev"
+ , "libghc-unix-compat-dev"
+ , "libghc-ansi-terminal-dev"
+ , "libghc-ifelse-dev"
+ , "libghc-network-dev"
+ , "libghc-mtl-dev"
+ , "libghc-transformers-dev"
+ , "libghc-exceptions-dev"
+ , "libghc-stm-dev"
+ , "libghc-text-dev"
+ , "make"
+ ]
+ fbsddeps =
+ [ "gnupg"
+ , "ghc"
+ , "hs-cabal-install"
+ , "hs-async"
+ , "hs-MissingH"
+ , "hs-hslogger"
+ , "hs-unix-compat"
+ , "hs-ansi-terminal"
+ , "hs-IfElse"
+ , "hs-network"
+ , "hs-mtl"
+ , "hs-transformers-base"
+ , "hs-exceptions"
+ , "hs-stm"
+ , "hs-text"
+ , "gmake"
+ ]
+
+installGitCommand :: Maybe System -> ShellCommand
+installGitCommand msys = case msys of
+ (Just (System (Debian _) _)) -> use apt
+ (Just (System (Buntish _) _)) -> use apt
+ (Just (System (FreeBSD _) _)) -> use
+ [ "ASSUME_ALWAYS_YES=yes pkg update"
+ , "ASSUME_ALWAYS_YES=yes pkg install git"
+ ]
+ -- assume a debian derived system when not specified
+ Nothing -> use apt
+ where
+ use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi"
+ apt =
+ [ "apt-get update"
+ , "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
+ ]
+
+buildPropellor :: Maybe Host -> IO ()
+buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $
+ errorMessage "Propellor build failed!"
+ where
+ msys = case fmap (fromInfo . hostInfo) mh of
+ Just (InfoVal sys) -> Just sys
+ _ -> Nothing
+
+-- Build propellor using cabal or stack, and symlink propellor to the
+-- built binary.
+build :: Maybe System -> IO Bool
+build msys = catchBoolIO $ do
+ bs <- getGitConfigValue "propellor.buildsystem"
+ case bs of
+ Just "stack" -> stackBuild msys
+ _ -> cabalBuild msys
+
+-- For speed, only runs cabal configure when it's not been run before.
+-- If the build fails cabal may need to have configure re-run.
+--
+-- If the cabal configure fails, and a System is provided, installs
+-- dependencies and retries.
+cabalBuild :: Maybe System -> IO Bool
+cabalBuild msys = do
+ make "dist/setup-config" ["propellor.cabal"] cabal_configure
+ unlessM cabal_build $
+ unlessM (cabal_configure <&&> cabal_build) $
+ error "cabal build failed"
+ -- For safety against eg power loss in the middle of the build,
+ -- make a copy of the binary, and move it into place atomically.
+ -- This ensures that the propellor symlink only ever points at
+ -- a binary that is fully built. Also, avoid ever removing
+ -- or breaking the symlink.
+ --
+ -- Need cp -a to make build timestamp checking work.
+ unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
+ error "cp of binary failed"
+ rename (tmpfor safetycopy) safetycopy
+ symlinkPropellorBin safetycopy
+ return True
+ where
+ cabalbuiltbin = "dist/build/propellor-config/propellor-config"
+ safetycopy = cabalbuiltbin ++ ".built"
+ cabal_configure = ifM (cabal ["configure"])
+ ( return True
+ , case msys of
+ Nothing -> return False
+ Just sys ->
+ boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))]
+ <&&> cabal ["configure"]
+ )
+ cabal_build = cabal ["build", "propellor-config"]
+
+stackBuild :: Maybe System -> IO Bool
+stackBuild _msys = do
+ createDirectoryIfMissing True builddest
+ ifM (stack buildparams)
+ ( do
+ symlinkPropellorBin (builddest </> "propellor-config")
+ return True
+ , return False
+ )
+ where
+ builddest = ".built"
+ buildparams =
+ [ "--local-bin-path", builddest
+ , "build"
+ , ":propellor-config" -- only build config program
+ , "--copy-bins"
+ ]
+
+-- Atomic symlink creation/update.
+symlinkPropellorBin :: FilePath -> IO ()
+symlinkPropellorBin bin = do
+ createSymbolicLink bin (tmpfor dest)
+ rename (tmpfor dest) dest
+ where
+ dest = "propellor"
+
+tmpfor :: FilePath -> FilePath
+tmpfor f = f ++ ".propellortmp"
+
+make :: FilePath -> [FilePath] -> IO Bool -> IO ()
+make dest srcs builder = do
+ dt <- getmtime dest
+ st <- mapM getmtime srcs
+ when (dt == Nothing || any (> dt) st) $
+ unlessM builder $
+ error $ "failed to make " ++ dest
+ where
+ getmtime = catchMaybeIO . getModificationTime
+
+cabal :: [String] -> IO Bool
+cabal = boolSystem "cabal" . map Param
+
+stack :: [String] -> IO Bool
+stack = boolSystem "stack" . map Param
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 415b8576..fc256109 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -1,110 +1,143 @@
-module Propellor.CmdLine where
+module Propellor.CmdLine (
+ defaultMain,
+ processCmdLine,
+) where
import System.Environment (getArgs)
import Data.List
import System.Exit
-import System.Log.Logger
-import System.Log.Formatter
-import System.Log.Handler (setFormatter, LogHandler)
-import System.Log.Handler.Simple
import System.PosixCompat
-import Control.Exception (bracket)
-import System.Posix.IO
-import Data.Time.Clock.POSIX
-
-import Propellor
+import Network.Socket
+
+import Propellor.Base
+import Propellor.Gpg
+import Propellor.Git
+import Propellor.Git.VerifiedBranch
+import Propellor.Bootstrap
+import Propellor.Spin
+import Propellor.Types.CmdLine
import qualified Propellor.Property.Docker as Docker
-import qualified Propellor.Property.Docker.Shim as DockerShim
-import Utility.FileMode
-import Utility.SafeCommand
-import Utility.UserInfo
+import qualified Propellor.Property.Chroot as Chroot
+import qualified Propellor.Shim as Shim
+
+usage :: Handle -> IO ()
+usage h = hPutStrLn h $ unlines
+ [ "Usage:"
+ , " propellor --init"
+ , " propellor"
+ , " propellor hostname"
+ , " propellor --spin targethost [--via relayhost]"
+ , " propellor --add-key keyid"
+ , " propellor --rm-key keyid"
+ , " propellor --list-fields"
+ , " propellor --dump field context"
+ , " propellor --edit field context"
+ , " propellor --set field context"
+ , " propellor --unset field context"
+ , " propellor --unset-unused"
+ , " propellor --merge"
+ , " propellor --build"
+ , " propellor --check"
+ ]
-usage :: IO a
-usage = do
- putStrLn $ unlines
- [ "Usage:"
- , " propellor"
- , " propellor hostname"
- , " propellor --spin hostname"
- , " propellor --add-key keyid"
- , " propellor --set field context"
- , " propellor --dump field context"
- , " propellor --edit field context"
- , " propellor --list-fields"
- ]
- exitFailure
+usageError :: [String] -> IO a
+usageError ps = do
+ usage stderr
+ error ("(Unexpected: " ++ show ps)
processCmdLine :: IO CmdLine
processCmdLine = go =<< getArgs
where
- go ("--help":_) = usage
- go ("--spin":h:[]) = return $ Spin h
- go ("--boot":h:[]) = return $ Boot h
+ go ("--check":_) = return Check
+ go ("--spin":ps) = case reverse ps of
+ (r:"--via":hs) -> Spin
+ <$> mapM hostname (reverse hs)
+ <*> pure (Just r)
+ _ -> Spin <$> mapM hostname ps <*> pure Nothing
go ("--add-key":k:[]) = return $ AddKey k
+ go ("--rm-key":k:[]) = return $ RmKey k
go ("--set":f:c:[]) = withprivfield f c Set
+ go ("--unset":f:c:[]) = withprivfield f c Unset
+ go ("--unset-unused":[]) = return UnsetUnused
go ("--dump":f:c:[]) = withprivfield f c Dump
go ("--edit":f:c:[]) = withprivfield f c Edit
go ("--list-fields":[]) = return ListFields
- go ("--continue":s:[]) = case readish s of
- Just cmdline -> return $ Continue cmdline
- Nothing -> errorMessage "--continue serialization failure"
- go ("--chain":h:[]) = return $ Chain h
- go ("--docker":h:[]) = return $ Docker h
+ go ("--merge":[]) = return Merge
+ go ("--help":_) = do
+ usage stdout
+ exitFailure
+ go ("--boot":_:[]) = return $ Update Nothing -- for back-compat
+ go ("--serialized":s:[]) = serialized Serialized s
+ go ("--continue":s:[]) = serialized Continue s
+ go ("--gitpush":fin:fout:_) = return $ GitPush (Prelude.read fin) (Prelude.read fout)
+ go ("--run":h:[]) = go [h]
go (h:[])
- | "--" `isPrefixOf` h = usage
- | otherwise = return $ Run h
+ | "--" `isPrefixOf` h = usageError [h]
+ | otherwise = Run <$> hostname h
go [] = do
s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
if null s
then errorMessage "Cannot determine hostname! Pass it on the command line."
else return $ Run s
- go _ = usage
+ go v = usageError v
withprivfield s c f = case readish s of
Just pf -> return $ f pf (Context c)
Nothing -> errorMessage $ "Unknown privdata field " ++ s
+ serialized mk s = case readish s of
+ Just cmdline -> return $ mk cmdline
+ Nothing -> errorMessage $ "serialization failure (" ++ s ++ ")"
+
+data CanRebuild = CanRebuild | NoRebuild
+
+-- | Runs propellor on hosts, as controlled by command-line options.
defaultMain :: [Host] -> IO ()
-defaultMain hostlist = do
- DockerShim.cleanEnv
+defaultMain hostlist = withConcurrentOutput $ do
+ Shim.cleanEnv
checkDebugMode
cmdline <- processCmdLine
debug ["command line: ", show cmdline]
- go True cmdline
+ go CanRebuild cmdline
where
- go _ (Continue cmdline) = go False cmdline
+ go cr (Serialized cmdline) = go cr cmdline
+ go _ Check = return ()
go _ (Set field context) = setPrivData field context
+ go _ (Unset field context) = unsetPrivData field context
+ go _ (UnsetUnused) = unsetPrivDataUnused hostlist
go _ (Dump field context) = dumpPrivData field context
go _ (Edit field context) = editPrivData field context
go _ ListFields = listPrivDataFields hostlist
go _ (AddKey keyid) = addKey keyid
- go _ (Chain hn) = withhost hn $ \h -> do
- r <- runPropellor h $ ensureProperties $ hostProperties h
- putStrLn $ "\n" ++ show r
- go _ (Docker hn) = Docker.chain hn
- go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
- go True cmdline = updateFirst cmdline $ go False cmdline
- go False (Spin hn) = withhost hn $ spin hn
- go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
- ( onlyProcess $ withhost hn mainProperties
- , go True (Spin hn)
+ go _ (RmKey keyid) = rmKey keyid
+ go _ c@(ChrootChain _ _ _ _) = Chroot.chain hostlist c
+ go _ (DockerChain hn cid) = Docker.chain hostlist hn cid
+ go _ (DockerInit hn) = Docker.init hn
+ go _ (GitPush fin fout) = gitPushHelper fin fout
+ go cr (Relay h) = forceConsole >>
+ updateFirst Nothing cr (Update (Just h)) (update (Just h))
+ go _ (Update Nothing) = forceConsole >>
+ fetchFirst (onlyprocess (update Nothing))
+ go _ (Update (Just h)) = update (Just h)
+ go _ Merge = mergeSpin
+ go cr cmdline@(Spin hs mrelay) = buildFirst Nothing cr cmdline $ do
+ unless (isJust mrelay) commitSpin
+ forM_ hs $ \hn -> withhost hn $ spin mrelay hn
+ go cr cmdline@(Run hn) = ifM ((==) 0 <$> getRealUserID)
+ ( updateFirst (findHost hostlist hn) cr cmdline $ runhost hn
+ , fetchFirst $ go cr (Spin [hn] Nothing)
)
- go False (Boot hn) = onlyProcess $ withhost hn boot
+ go cr cmdline@(SimpleRun hn) = forceConsole >>
+ fetchFirst (buildFirst (findHost hostlist hn) cr cmdline (runhost hn))
+ -- When continuing after a rebuild, don't want to rebuild again.
+ go _ (Continue cmdline) = go NoRebuild cmdline
withhost :: HostName -> (Host -> IO ()) -> IO ()
withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
-onlyProcess :: IO a -> IO a
-onlyProcess a = bracket lock unlock (const a)
- where
- lock = do
- l <- createFile lockfile stdFileMode
- setLock l (WriteLock, AbsoluteSeek, 0, 0)
- `catchIO` const alreadyrunning
- return l
- unlock = closeFd
- alreadyrunning = error "Propellor is already running on this host!"
- lockfile = localdir </> ".lock"
+ runhost hn = onlyprocess $ withhost hn mainProperties
+
+ onlyprocess = onlyProcess (localdir </> ".lock")
unknownhost :: HostName -> [Host] -> IO a
unknownhost h hosts = errorMessage $ unlines
@@ -114,293 +147,66 @@ unknownhost h hosts = errorMessage $ unlines
, "Known hosts: " ++ unwords (map hostName hosts)
]
-buildFirst :: CmdLine -> IO () -> IO ()
-buildFirst cmdline next = do
+-- Builds propellor (when allowed) and if it looks like a new binary,
+-- re-execs it to continue.
+-- Otherwise, runs the IO action to continue.
+--
+-- The Host should only be provided when dependencies should be installed
+-- as needed to build propellor.
+buildFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+buildFirst h CanRebuild cmdline next = do
oldtime <- getmtime
- ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
- ( do
- newtime <- getmtime
- if newtime == oldtime
- then next
- else void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
- , errorMessage "Propellor build failed!"
- )
- where
- getmtime = catchMaybeIO $ getModificationTime "propellor"
-
-getCurrentBranch :: IO String
-getCurrentBranch = takeWhile (/= '\n')
- <$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
-
-updateFirst :: CmdLine -> IO () -> IO ()
-updateFirst cmdline next = do
- branchref <- getCurrentBranch
- let originbranch = "origin" </> branchref
-
- void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
-
- oldsha <- getCurrentGitSha1 branchref
-
- whenM (doesFileExist keyring) $ do
- {- To verify origin branch commit's signature, have to
- - convince gpg to use our keyring. While running git log.
- - Which has no way to pass options to gpg.
- - Argh! -}
- let gpgconf = privDataDir </> "gpg.conf"
- writeFile gpgconf $ unlines
- [ " keyring " ++ keyring
- , "no-auto-check-trustdb"
- ]
- -- gpg is picky about perms
- modifyFileMode privDataDir (removeModes otherGroupModes)
- s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]
- (Just [("GNUPGHOME", privDataDir)])
- nukeFile $ privDataDir </> "trustdb.gpg"
- nukeFile $ privDataDir </> "pubring.gpg"
- nukeFile $ privDataDir </> "gpg.conf"
- if s == "U\n" || s == "G\n"
- then do
- putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
- hFlush stdout
- void $ boolSystem "git" [Param "merge", Param originbranch]
- else warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
-
- newsha <- getCurrentGitSha1 branchref
-
- if oldsha == newsha
+ buildPropellor h
+ newtime <- getmtime
+ if newtime == oldtime
then next
- else ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
- ( void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
- , errorMessage "Propellor build failed!"
- )
-
-getCurrentGitSha1 :: String -> IO String
-getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
-
-spin :: HostName -> Host -> IO ()
-spin hn hst = do
- url <- getUrl
- void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
- void $ boolSystem "git" [Param "push"]
- cacheparams <- toCommand <$> sshCachingParams hn
- go cacheparams url =<< hostprivdata
+ else continueAfterBuild cmdline
where
- hostprivdata = show . filterPrivData hst <$> decryptPrivData
-
- go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
- let finish = do
- senddata toh "privdata" privDataMarker privdata
- hClose toh
-
- -- Display remaining output.
- void $ tryIO $ forever $
- showremote =<< hGetLine fromh
- hClose fromh
- status <- getstatus fromh `catchIO` (const $ errorMessage "protocol error (perhaps the remote propellor failed to run?)")
- case status of
- Ready -> finish
- NeedGitClone -> do
- hClose toh
- hClose fromh
- sendGitClone hn url
- go cacheparams url privdata
-
- user = "root@"++hn
-
- bootstrapcmd = shellWrap $ intercalate " ; "
- [ "if [ ! -d " ++ localdir ++ " ]"
- , "then " ++ intercalate " && "
- [ "apt-get update"
- , "apt-get --no-install-recommends --no-upgrade -y install git make"
- , "echo " ++ toMarked statusMarker (show NeedGitClone)
- ]
- , "else " ++ intercalate " && "
- [ "cd " ++ localdir
- , "if ! test -x ./propellor; then make deps build; fi"
- , "./propellor --boot " ++ hn
- ]
- , "fi"
- ]
-
- getstatus :: Handle -> IO BootStrapStatus
- getstatus h = do
- l <- hGetLine h
- case readish =<< fromMarked statusMarker l of
- Nothing -> do
- showremote l
- getstatus h
- Just status -> return status
-
- showremote s = putStrLn s
- senddata toh desc marker s = void $
- actionMessage ("Sending " ++ desc ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do
- sendMarked toh marker s
- return True
-
--- Initial git clone, used for bootstrapping.
-sendGitClone :: HostName -> String -> IO ()
-sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) $ do
- branch <- getCurrentBranch
- cacheparams <- sshCachingParams hn
- withTmpFile "propellor.git" $ \tmp _ -> allM id
- [ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
- , boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
- , boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]
- ]
- where
- remotebundle = "/usr/local/propellor.git"
- unpackcmd branch = shellWrap $ intercalate " && "
- [ "git clone " ++ remotebundle ++ " " ++ localdir
- , "cd " ++ localdir
- , "git checkout -b " ++ branch
- , "git remote rm origin"
- , "rm -f " ++ remotebundle
- , "git remote add origin " ++ url
- -- same as --set-upstream-to, except origin branch
- -- has not been pulled yet
- , "git config branch."++branch++".remote origin"
- , "git config branch."++branch++".merge refs/heads/"++branch
- ]
-
-data BootStrapStatus = Ready | NeedGitClone
- deriving (Read, Show, Eq)
-
-type Marker = String
-type Marked = String
-
-statusMarker :: Marker
-statusMarker = "STATUS"
-
-privDataMarker :: String
-privDataMarker = "PRIVDATA "
-
-toMarked :: Marker -> String -> String
-toMarked marker = intercalate "\n" . map (marker ++) . lines
-
-sendMarked :: Handle -> Marker -> String -> IO ()
-sendMarked h marker s = do
- -- Prefix string with newline because sometimes a
- -- incomplete line is output.
- hPutStrLn h ("\n" ++ toMarked marker s)
- hFlush h
-
-fromMarked :: Marker -> Marked -> Maybe String
-fromMarked marker s
- | null matches = Nothing
- | otherwise = Just $ intercalate "\n" $
- map (drop len) matches
- where
- len = length marker
- matches = filter (marker `isPrefixOf`) $ lines s
-
-boot :: Host -> IO ()
-boot h = do
- sendMarked stdout statusMarker $ show Ready
- reply <- hGetContentsStrict stdin
-
- makePrivDataDir
- maybe noop (writeFileProtected privDataLocal) $
- fromMarked privDataMarker reply
- mainProperties h
-
-addKey :: String -> IO ()
-addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitconfig, gitcommit ]
- where
- gpg = do
- createDirectoryIfMissing True privDataDir
- boolSystem "sh"
- [ Param "-c"
- , Param $ "gpg --export " ++ keyid ++ " | gpg " ++
- unwords (gpgopts ++ ["--import"])
- ]
- gitadd = boolSystem "git"
- [ Param "add"
- , File keyring
- ]
-
- gitconfig = boolSystem "git"
- [ Param "config"
- , Param "user.signingkey"
- , Param keyid
- ]
-
- gitcommit = gitCommit
- [ File keyring
- , Param "-m"
- , Param "propellor addkey"
- ]
-
-{- Automatically sign the commit if there'a a keyring. -}
-gitCommit :: [CommandParam] -> IO Bool
-gitCommit ps = do
- k <- doesFileExist keyring
- boolSystem "git" $ catMaybes $
- [ Just (Param "commit")
- , if k then Just (Param "--gpg-sign") else Nothing
- ] ++ map Just ps
-
-keyring :: FilePath
-keyring = privDataDir </> "keyring.gpg"
-
-gpgopts :: [String]
-gpgopts = ["--options", "/dev/null", "--no-default-keyring", "--keyring", keyring]
-
-getUrl :: IO String
-getUrl = maybe nourl return =<< getM get urls
- where
- urls = ["remote.deploy.url", "remote.origin.url"]
- nourl = errorMessage $ "Cannot find deploy url in " ++ show urls
- get u = do
- v <- catchMaybeIO $
- takeWhile (/= '\n')
- <$> readProcess "git" ["config", u]
- return $ case v of
- Just url | not (null url) -> Just url
- _ -> Nothing
+ getmtime = catchMaybeIO $ getModificationTime "propellor"
+buildFirst _ NoRebuild _ next = next
-checkDebugMode :: IO ()
-checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
+continueAfterBuild :: CmdLine -> IO a
+continueAfterBuild cmdline = go =<< boolSystem "./propellor"
+ [ Param "--continue"
+ , Param (show cmdline)
+ ]
where
- go (Just s)
- | s == "1" = do
- f <- setFormatter
- <$> streamHandler stderr DEBUG
- <*> pure (simpleLogFormatter "[$time] $msg")
- updateGlobalLogger rootLoggerName $
- setLevel DEBUG . setHandlers [f]
- go _ = noop
-
--- Parameters can be passed to both ssh and scp, to enable a ssh connection
--- caching socket.
---
--- If the socket already exists, check if its mtime is older than 10
--- minutes, and if so stop that ssh process, in order to not try to
--- use an old stale connection. (atime would be nicer, but there's
--- a good chance a laptop uses noatime)
-sshCachingParams :: HostName -> IO [CommandParam]
-sshCachingParams hn = do
- home <- myHomeDir
- let cachedir = home </> ".ssh" </> "propellor"
- createDirectoryIfMissing False cachedir
- let socketfile = cachedir </> hn ++ ".sock"
- let ps =
- [ Param "-o", Param ("ControlPath=" ++ socketfile)
- , Params "-o ControlMaster=auto -o ControlPersist=yes"
- ]
-
- maybe noop (expireold ps socketfile)
- =<< catchMaybeIO (getFileStatus socketfile)
-
- return ps
-
+ go True = exitSuccess
+ go False = exitWith (ExitFailure 1)
+
+fetchFirst :: IO () -> IO ()
+fetchFirst next = do
+ whenM hasOrigin $
+ void fetchOrigin
+ next
+
+updateFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+updateFirst h canrebuild cmdline next = ifM hasOrigin
+ ( updateFirst' h canrebuild cmdline next
+ , next
+ )
+
+-- If changes can be fetched from origin, Builds propellor (when allowed)
+-- and re-execs the updated propellor binary to continue.
+-- Otherwise, runs the IO action to continue.
+updateFirst' :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+updateFirst' h CanRebuild cmdline next = ifM fetchOrigin
+ ( do
+ buildPropellor h
+ continueAfterBuild cmdline
+ , next
+ )
+updateFirst' _ NoRebuild _ next = next
+
+-- Gets the fully qualified domain name, given a string that might be
+-- a short name to look up in the DNS.
+hostname :: String -> IO HostName
+hostname s = go =<< catchDefaultIO [] dnslookup
where
- expireold ps f s = do
- now <- truncate <$> getPOSIXTime :: IO Integer
- if modificationTime s > fromIntegral now - tenminutes
- then touchFile f
- else do
- void $ boolSystem "ssh" $
- [ Params "-O stop" ] ++ ps ++
- [ Param "localhost" ]
- nukeFile f
- tenminutes = 600
+ dnslookup = getAddrInfo (Just canonname) (Just s) Nothing
+ canonname = defaultHints { addrFlags = [AI_CANONNAME] }
+ go (AddrInfo { addrCanonName = Just v } : _) = pure v
+ go _
+ | "." `isInfixOf` s = pure s -- assume it's a fqdn
+ | otherwise =
+ error $ "cannot find host " ++ s ++ " in the DNS"
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
new file mode 100644
index 00000000..c4d6f864
--- /dev/null
+++ b/src/Propellor/Container.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE DataKinds, TypeFamilies #-}
+
+module Propellor.Container where
+
+import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
+import Propellor.Types.Info
+import Propellor.Info
+import Propellor.PrivData
+import Propellor.PropAccum
+
+class IsContainer c where
+ containerProperties :: c -> [ChildProperty]
+ containerInfo :: c -> Info
+ setContainerProperties :: c -> [ChildProperty] -> c
+
+instance IsContainer Host where
+ containerProperties = hostProperties
+ containerInfo = hostInfo
+ setContainerProperties h ps = host (hostName h) (Props ps)
+
+-- | Note that the metatype of a container's properties is not retained,
+-- so this defaults to UnixLike. So, using this with setContainerProps can
+-- add properties to a container that conflict with properties already in it.
+-- Use caution when using this; only add properties that do not have
+-- restricted targets.
+containerProps :: IsContainer c => c -> Props UnixLike
+containerProps = Props . containerProperties
+
+setContainerProps :: IsContainer c => c -> Props metatypes -> c
+setContainerProps c (Props ps) = setContainerProperties c ps
+
+-- | Adjust the provided Property, adding to its
+-- propertyChidren the properties of the provided container.
+--
+-- The Info of the propertyChildren is adjusted to only include
+-- info that should be propagated out to the Property.
+--
+-- Any PrivInfo that uses HostContext is adjusted to use the name
+-- of the container as its context.
+propagateContainer
+ ::
+ -- Since the children being added probably have info,
+ -- require the Property's metatypes to have info.
+ ( IncludesInfo metatypes ~ 'True
+ , IsContainer c
+ )
+ => String
+ -> c
+ -> Property metatypes
+ -> Property metatypes
+propagateContainer containername c prop = prop
+ `addChildren` map convert (containerProperties c)
+ where
+ convert p =
+ let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
+ n' = n
+ `setInfoProperty` mapInfo (forceHostContext containername)
+ (propagatableInfo (getInfo p))
+ `addChildren` map convert (getChildren p)
+ in toChildProperty n'
diff --git a/src/Propellor/Debug.hs b/src/Propellor/Debug.hs
new file mode 100644
index 00000000..5e729b23
--- /dev/null
+++ b/src/Propellor/Debug.hs
@@ -0,0 +1,37 @@
+module Propellor.Debug where
+
+import Control.Monad.IfElse
+import System.IO
+import System.Log.Logger
+import System.Log.Formatter
+import System.Log.Handler (setFormatter)
+import System.Log.Handler.Simple
+import Control.Applicative
+import Prelude
+
+import Utility.Monad
+import Utility.Env
+import Utility.Exception
+import Utility.Process
+import Utility.Directory
+
+debug :: [String] -> IO ()
+debug = debugM "propellor" . unwords
+
+checkDebugMode :: IO ()
+checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
+ where
+ go (Just "1") = enableDebugMode
+ go (Just _) = noop
+ go Nothing = whenM (doesDirectoryExist ".git") $
+ whenM (elem "1" . lines <$> getgitconfig) enableDebugMode
+ getgitconfig = catchDefaultIO "" $
+ readProcess "git" ["config", "propellor.debug"]
+
+enableDebugMode :: IO ()
+enableDebugMode = do
+ f <- setFormatter
+ <$> streamHandler stderr DEBUG
+ <*> pure (simpleLogFormatter "[$time] $msg")
+ updateGlobalLogger rootLoggerName $
+ setLevel DEBUG . setHandlers [f]
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
new file mode 100644
index 00000000..f32b52a4
--- /dev/null
+++ b/src/Propellor/DotDir.hs
@@ -0,0 +1,422 @@
+module Propellor.DotDir
+ ( distrepo
+ , dotPropellor
+ , interactiveInit
+ , checkRepoUpToDate
+ ) where
+
+import Propellor.Message
+import Propellor.Bootstrap
+import Propellor.Git
+import Propellor.Gpg
+import Propellor.Types.Result
+import Utility.UserInfo
+import Utility.Monad
+import Utility.Process
+import Utility.SafeCommand
+import Utility.Exception
+import Utility.Directory
+import Utility.Path
+-- This module is autogenerated by the build system.
+import qualified Paths_propellor as Package
+
+import Data.Char
+import Data.List
+import Data.Version
+import Control.Monad
+import Control.Monad.IfElse
+import System.FilePath
+import System.Posix.Directory
+import System.IO
+import System.Console.Concurrent
+import Control.Applicative
+import Prelude
+
+distdir :: FilePath
+distdir = "/usr/src/propellor"
+
+-- A distribution may include a bundle of propellor's git repository here.
+-- If not, it will be pulled from the network when needed.
+distrepo :: FilePath
+distrepo = distdir </> "propellor.git"
+
+-- File containing the head rev of the distrepo.
+disthead :: FilePath
+disthead = distdir </> "head"
+
+upstreambranch :: String
+upstreambranch = "upstream/master"
+
+-- Using the github mirror of the main propellor repo because
+-- it is accessible over https for better security.
+netrepo :: String
+netrepo = "https://github.com/joeyh/propellor.git"
+
+dotPropellor :: IO FilePath
+dotPropellor = do
+ home <- myHomeDir
+ return (home </> ".propellor")
+
+-- Detect if propellor was built using stack. This is somewhat of a hack.
+buildSystem :: IO String
+buildSystem = do
+ d <- Package.getLibDir
+ return $ if "stack-work" `isInfixOf` d then "stack" else "cabal"
+
+interactiveInit :: IO ()
+interactiveInit = ifM (doesDirectoryExist =<< dotPropellor)
+ ( error "~/.propellor/ already exists, not doing anything"
+ , do
+ welcomeBanner
+ setup
+ )
+
+-- | Determine whether we need to create a cabal sandbox in ~/.propellor/,
+-- which we do if the user has configured cabal to require a sandbox, and the
+-- build system is cabal.
+cabalSandboxRequired :: IO Bool
+cabalSandboxRequired = ifM cabal
+ ( do
+ home <- myHomeDir
+ ls <- lines <$> catchDefaultIO []
+ (readFile (home </> ".cabal" </> "config"))
+ -- For simplicity, we assume a sane ~/.cabal/config here:
+ return $ any ("True" `isInfixOf`) $
+ filter ("require-sandbox:" `isPrefixOf`) ls
+ , return False
+ )
+ where
+ cabal = buildSystem >>= \bSystem -> return (bSystem == "cabal")
+
+say :: String -> IO ()
+say = outputConcurrent
+
+sayLn :: String -> IO ()
+sayLn s = say (s ++ "\n")
+
+welcomeBanner :: IO ()
+welcomeBanner = say $ unlines $ map prettify
+ [ ""
+ , ""
+ , " _ ______`| ,-.__"
+ , " .--------------------------- / ~___-=O`/|O`/__| (____.'"
+ , " - Welcome to -- ~ / | / ) _.-'-._"
+ , " - Propellor! -- `/-==__ _/__|/__=-| ( ~_"
+ , " `--------------------------- * ~ | | '--------'"
+ , " (o) `"
+ , ""
+ , ""
+ ]
+ where
+ prettify = map (replace '~' '\\')
+ replace x y c
+ | c == x = y
+ | otherwise = c
+
+prompt :: String -> [(String, IO ())] -> IO ()
+prompt p cs = do
+ say (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ")
+ flushConcurrentOutput
+ hFlush stdout
+ r <- map toLower <$> getLine
+ if null r
+ then snd (head cs) -- default to first choice on return
+ else case filter (\(s, _) -> map toLower s == r) cs of
+ [(_, a)] -> a
+ _ -> do
+ sayLn "Not a valid choice, try again.. (Or ctrl-c to quit)"
+ prompt p cs
+
+section :: IO ()
+section = do
+ sayLn ""
+ sayLn "------------------------------------------------------------------------------"
+ sayLn ""
+
+setup :: IO ()
+setup = do
+ sayLn "Propellor's configuration file is ~/.propellor/config.hs"
+ sayLn ""
+ sayLn "Let's get you started with a simple config that you can adapt"
+ sayLn "to your needs. You can start with:"
+ sayLn " A: A clone of propellor's git repository (most flexible)"
+ sayLn " B: The bare minimum files to use propellor (most simple)"
+ prompt "Which would you prefer?"
+ [ ("A", void $ actionMessage "Cloning propellor's git repository" fullClone)
+ , ("B", void $ actionMessage "Creating minimal config" minimalConfig)
+ ]
+ changeWorkingDirectory =<< dotPropellor
+
+ section
+ sayLn "Let's try building the propellor configuration, to make sure it will work..."
+ sayLn ""
+ b <- buildSystem
+ void $ boolSystem "git"
+ [ Param "config"
+ , Param "propellor.buildsystem"
+ , Param b
+ ]
+ ifM cabalSandboxRequired
+ ( void $ boolSystem "cabal"
+ [ Param "sandbox"
+ , Param "init"
+ ]
+ , return ()
+ )
+ buildPropellor Nothing
+ sayLn ""
+ sayLn "Great! Propellor is bootstrapped."
+
+ section
+ sayLn "Propellor can use gpg to encrypt private data about the systems it manages,"
+ sayLn "and to sign git commits."
+ gpg <- getGpgBin
+ ifM (inPath gpg)
+ ( setupGpgKey
+ , do
+ sayLn "You don't seem to have gpg installed, so skipping setting it up."
+ explainManualSetupGpgKey
+ )
+
+ section
+ sayLn "Everything is set up ..."
+ sayLn "Your next step is to edit ~/.propellor/config.hs"
+ sayLn "and run propellor again to try it out."
+ sayLn ""
+ sayLn "For docs, see https://propellor.branchable.com/"
+ sayLn "Enjoy propellor!"
+
+explainManualSetupGpgKey :: IO ()
+explainManualSetupGpgKey = do
+ sayLn "Propellor can still be used without gpg, but it won't be able to"
+ sayLn "manage private data. You can set this up later:"
+ sayLn " 1. gpg --gen-key"
+ sayLn " 2. propellor --add-key (pass it the key ID generated in step 1)"
+
+setupGpgKey :: IO ()
+setupGpgKey = do
+ ks <- listSecretKeys
+ sayLn ""
+ case ks of
+ [] -> makeGpgKey
+ [(k, d)] -> do
+ sayLn $ "You have one gpg key: " ++ desckey k d
+ prompt "Should propellor use that key?"
+ [ ("Y", propellorAddKey k)
+ , ("N", sayLn $ "Skipping gpg setup. If you change your mind, run: propellor --add-key " ++ k)
+ ]
+ _ -> do
+ let nks = zip ks (map show ([1..] :: [Integer]))
+ sayLn "I see you have several gpg keys:"
+ forM_ nks $ \((k, d), n) ->
+ sayLn $ " " ++ n ++ " " ++ desckey k d
+ prompt "Which of your gpg keys should propellor use?"
+ (map (\((k, _), n) -> (n, propellorAddKey k)) nks)
+ where
+ desckey k d = d ++ " (keyid " ++ k ++ ")"
+
+makeGpgKey :: IO ()
+makeGpgKey = do
+ sayLn "You seem to not have any gpg secret keys."
+ prompt "Would you like to create one now?"
+ [("Y", rungpg), ("N", nope)]
+ where
+ nope = do
+ sayLn "No problem."
+ explainManualSetupGpgKey
+ rungpg = do
+ sayLn "Running gpg --gen-key ..."
+ gpg <- getGpgBin
+ void $ boolSystem gpg [Param "--gen-key"]
+ ks <- listSecretKeys
+ case ks of
+ [] -> do
+ sayLn "Hmm, gpg seemed to not set up a secret key."
+ prompt "Want to try running gpg again?"
+ [("Y", rungpg), ("N", nope)]
+ ((k, _):_) -> propellorAddKey k
+
+propellorAddKey :: String -> IO ()
+propellorAddKey keyid = do
+ sayLn ""
+ sayLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid
+ d <- dotPropellor
+ unlessM (boolSystem (d </> "propellor") [Param "--add-key", Param keyid]) $ do
+ sayLn "Oops, that didn't work! You can retry the same command later."
+ sayLn "Continuing onward ..."
+
+minimalConfig :: IO Result
+minimalConfig = do
+ d <- dotPropellor
+ createDirectoryIfMissing True d
+ changeWorkingDirectory d
+ void $ boolSystem "git" [Param "init"]
+ addfile "config.cabal" cabalcontent
+ addfile "config.hs" configcontent
+ addfile "stack.yaml" stackcontent
+ return MadeChange
+ where
+ addfile f content = do
+ writeFile f (unlines content)
+ void $ boolSystem "git" [Param "add" , File f]
+ cabalcontent =
+ [ "-- This is a cabal file to use to build your propellor configuration."
+ , ""
+ , "Name: config"
+ , "Cabal-Version: >= 1.6"
+ , "Build-Type: Simple"
+ , "Version: 0"
+ , ""
+ , "Executable propellor-config"
+ , " Main-Is: config.hs"
+ , " GHC-Options: -threaded -Wall -fno-warn-tabs -O0"
+ , " Extensions: TypeOperators"
+ , " Build-Depends: propellor >= 3.0, base >= 3"
+ ]
+ configcontent =
+ [ "-- This is the main configuration file for Propellor, and is used to build"
+ , "-- the propellor program. https://propellor.branchable.com/"
+ , ""
+ , "import Propellor"
+ , "import qualified Propellor.Property.File as File"
+ , "import qualified Propellor.Property.Apt as Apt"
+ , "import qualified Propellor.Property.Cron as Cron"
+ , "import qualified Propellor.Property.User as User"
+ , ""
+ , "main :: IO ()"
+ , "main = defaultMain hosts"
+ , ""
+ , "-- The hosts propellor knows about."
+ , "hosts :: [Host]"
+ , "hosts ="
+ , " [ mybox"
+ , " ]"
+ , ""
+ , "-- An example host."
+ , "mybox :: Host"
+ , "mybox = host \"mybox.example.com\" $ props"
+ , " & osDebian Unstable \"amd64\""
+ , " & Apt.stdSourcesList"
+ , " & Apt.unattendedUpgrades"
+ , " & Apt.installed [\"etckeeper\"]"
+ , " & Apt.installed [\"ssh\"]"
+ , " & User.hasSomePassword (User \"root\")"
+ , " & File.dirExists \"/var/www\""
+ , " & Cron.runPropellor (Cron.Times \"30 * * * *\")"
+ , ""
+ ]
+ stackcontent =
+ -- This should be the same resolver version in propellor's
+ -- own stack.yaml
+ [ "resolver: lts-5.10"
+ , "packages:"
+ , "- '.'"
+ , "extra-deps:"
+ , "- propellor-" ++ showVersion Package.version
+ ]
+
+fullClone :: IO Result
+fullClone = do
+ d <- dotPropellor
+ let enterdotpropellor = changeWorkingDirectory d >> return True
+ ok <- ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
+ ( allM id
+ [ boolSystem "git" [Param "clone", File distrepo, File d]
+ , fetchUpstreamBranch distrepo
+ , enterdotpropellor
+ , boolSystem "git" [Param "remote", Param "rm", Param "origin"]
+ ]
+ , allM id
+ [ boolSystem "git" [Param "clone", Param netrepo, File d]
+ , enterdotpropellor
+ -- Rename origin to upstream and avoid
+ -- git push to that read-only repo.
+ , boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
+ , boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
+ ]
+ )
+ return (toResult ok)
+
+fetchUpstreamBranch :: FilePath -> IO Bool
+fetchUpstreamBranch repo = do
+ changeWorkingDirectory =<< dotPropellor
+ boolSystem "git"
+ [ Param "fetch"
+ , File repo
+ , Param ("+refs/heads/master:refs/remotes/" ++ upstreambranch)
+ , Param "--quiet"
+ ]
+
+checkRepoUpToDate :: IO ()
+checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do
+ headrev <- takeWhile (/= '\n') <$> readFile disthead
+ changeWorkingDirectory =<< dotPropellor
+ headknown <- catchMaybeIO $
+ withQuietOutput createProcessSuccess $
+ proc "git" ["log", headrev]
+ if (headknown == Nothing)
+ then setupUpstreamMaster headrev
+ else do
+ theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef
+ when (theirhead /= headrev) $ do
+ merged <- not . null <$>
+ readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
+ unless merged $
+ warnoutofdate True
+ where
+ gitbundleavail = doesFileExist disthead
+ dotpropellorpopulated = do
+ d <- dotPropellor
+ doesFileExist (d </> "propellor.cabal")
+
+-- Makes upstream/master in dotPropellor be a usefully mergeable branch.
+--
+-- We cannot just use origin/master, because in the case of a distrepo,
+-- it only contains 1 commit. So, trying to merge with it will result
+-- in lots of merge conflicts, since git cannot find a common parent
+-- commit.
+--
+-- Instead, the upstream/master branch is created by taking the
+-- upstream/master branch (which must be an old version of propellor,
+-- as distributed), and diffing from it to the current origin/master,
+-- and committing the result. This is done in a temporary clone of the
+-- repository, giving it a new master branch. That new branch is fetched
+-- into the user's repository, as if fetching from a upstream remote,
+-- yielding a new upstream/master branch.
+setupUpstreamMaster :: String -> IO ()
+setupUpstreamMaster newref = do
+ changeWorkingDirectory =<< dotPropellor
+ go =<< catchMaybeIO getoldrev
+ where
+ go Nothing = warnoutofdate False
+ go (Just oldref) = do
+ let tmprepo = ".git/propellordisttmp"
+ let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
+ cleantmprepo
+ git ["clone", "--quiet", ".", tmprepo]
+
+ changeWorkingDirectory tmprepo
+ git ["fetch", distrepo, "--quiet"]
+ git ["reset", "--hard", oldref, "--quiet"]
+ git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
+
+ void $ fetchUpstreamBranch tmprepo
+ cleantmprepo
+ warnoutofdate True
+
+ getoldrev = takeWhile (/= '\n')
+ <$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
+
+ git = run "git"
+ run cmd ps = unlessM (boolSystem cmd (map Param ps)) $
+ error $ "Failed to run " ++ cmd ++ " " ++ show ps
+
+warnoutofdate :: Bool -> IO ()
+warnoutofdate havebranch = do
+ warningMessage ("** Your ~/.propellor/ is out of date..")
+ let also s = hPutStrLn stderr (" " ++ s)
+ also ("A newer upstream version is available in " ++ distrepo)
+ if havebranch
+ then also ("To merge it, run: git merge " ++ upstreambranch)
+ else also ("To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again.")
+ also ""
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index a3fc0f30..8958da6b 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -1,49 +1,96 @@
{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE DataKinds #-}
-module Propellor.Engine where
+module Propellor.Engine (
+ mainProperties,
+ runPropellor,
+ ensureChildProperties,
+ fromHost,
+ fromHost',
+ onlyProcess,
+) where
import System.Exit
import System.IO
import Data.Monoid
+import "mtl" Control.Monad.RWS.Strict
+import System.PosixCompat
+import System.Posix.IO
+import System.FilePath
import Control.Applicative
-import System.Console.ANSI
-import "mtl" Control.Monad.Reader
+import Prelude
import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
import Propellor.Message
import Propellor.Exception
import Propellor.Info
+import Utility.Exception
+import Utility.Directory
-runPropellor :: Host -> Propellor a -> IO a
-runPropellor host a = runReaderT (runWithHost a) host
-
+-- | Gets the Properties of a Host, and ensures them all,
+-- with nice display of what's being done.
mainProperties :: Host -> IO ()
mainProperties host = do
- r <- runPropellor host $
- ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
- setTitle "propellor: done"
- hFlush stdout
- case r of
+ ret <- runPropellor host $ ensureChildProperties [toChildProperty overall]
+ messagesDone
+ case ret of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
+ where
+ overall :: Property (MetaTypes '[])
+ overall = property "overall" $
+ ensureChildProperties (hostProperties host)
+
+-- | Runs a Propellor action with the specified host.
+--
+-- If the Result is not FailedChange, any EndActions
+-- that were accumulated while running the action
+-- are then also run.
+runPropellor :: Host -> Propellor Result -> IO Result
+runPropellor host a = do
+ (res, endactions) <- evalRWST (runWithHost a) host ()
+ endres <- mapM (runEndAction host res) endactions
+ return $ mconcat (res:endres)
+
+runEndAction :: Host -> Result -> EndAction -> IO Result
+runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc $ do
+ (ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host ()
+ return ret
-ensureProperties :: [Property] -> Propellor Result
-ensureProperties ps = ensure ps NoChange
+-- | Ensures the child properties, with a display of each as it runs.
+ensureChildProperties :: [ChildProperty] -> Propellor Result
+ensureChildProperties ps = ensure ps NoChange
where
ensure [] rs = return rs
- ensure (l:ls) rs = do
+ ensure (p:ls) rs = do
hn <- asks hostName
- r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
+ r <- actionMessageOn hn (getDesc p) (catchPropellor $ getSatisfy p)
ensure ls (r <> rs)
-ensureProperty :: Property -> Propellor Result
-ensureProperty = catchPropellor . propertySatisfy
-
--- | Lifts an action into a different host.
+-- | Lifts an action into the context of a different host.
--
--- For example, `fromHost hosts "otherhost" getSshPubKey`
+-- > fromHost hosts "otherhost" Ssh.getHostPubKey
fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
fromHost l hn getter = case findHost l hn of
Nothing -> return Nothing
- Just h -> liftIO $ Just <$>
- runReaderT (runWithHost getter) h
+ Just h -> Just <$> fromHost' h getter
+
+fromHost' :: Host -> Propellor a -> Propellor a
+fromHost' h getter = do
+ (ret, _s, runlog) <- liftIO $ runRWST (runWithHost getter) h ()
+ tell runlog
+ return ret
+
+onlyProcess :: FilePath -> IO a -> IO a
+onlyProcess lockfile a = bracket lock unlock (const a)
+ where
+ lock = do
+ createDirectoryIfMissing True (takeDirectory lockfile)
+ l <- createFile lockfile stdFileMode
+ setLock l (WriteLock, AbsoluteSeek, 0, 0)
+ `catchIO` const alreadyrunning
+ return l
+ unlock = closeFd
+ alreadyrunning = error "Propellor is already running on this host!"
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
new file mode 100644
index 00000000..c4666722
--- /dev/null
+++ b/src/Propellor/EnsureProperty.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Propellor.EnsureProperty
+ ( ensureProperty
+ , property'
+ , OuterMetaTypesWitness(..)
+ ) where
+
+import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
+import Propellor.Exception
+
+import Data.Monoid
+import Prelude
+
+-- | For when code running in the Propellor monad needs to ensure a
+-- Property.
+--
+-- Use `property'` to get the `OuterMetaTypesWithness`. For example:
+--
+-- > foo = Property Debian
+-- > foo = property' "my property" $ \w -> do
+-- > ensureProperty w (aptInstall "foo")
+--
+-- The type checker will prevent using ensureProperty with a property
+-- that does not support the target OSes needed by the OuterMetaTypesWitness.
+-- In the example above, aptInstall must support Debian, since foo
+-- is supposed to support Debian.
+--
+-- The type checker will also prevent using ensureProperty with a property
+-- with HasInfo in its MetaTypes. Doing so would cause the `Info` associated
+-- with the property to be lost.
+ensureProperty
+ ::
+ ( Cannot_ensureProperty_WithInfo inner ~ 'True
+ , (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine
+ )
+ => OuterMetaTypesWitness outer
+ -> Property (MetaTypes inner)
+ -> Propellor Result
+ensureProperty _ = catchPropellor . getSatisfy
+
+-- The name of this was chosen to make type errors a more understandable.
+type family Cannot_ensureProperty_WithInfo (l :: [a]) :: Bool
+type instance Cannot_ensureProperty_WithInfo '[] = 'True
+type instance Cannot_ensureProperty_WithInfo (t ': ts) =
+ Not (t `EqT` 'WithInfo) && Cannot_ensureProperty_WithInfo ts
+
+-- | Constructs a property, like `property`, but provides its
+-- `OuterMetaTypesWitness`.
+property'
+ :: SingI metatypes
+ => Desc
+ -> (OuterMetaTypesWitness metatypes -> Propellor Result)
+ -> Property (MetaTypes metatypes)
+property' d a =
+ let p = Property sing d (a (outerMetaTypesWitness p)) mempty mempty
+ in p
+
+-- | Used to provide the metatypes of a Property to calls to
+-- 'ensureProperty` within it.
+newtype OuterMetaTypesWitness metatypes = OuterMetaTypesWitness (MetaTypes metatypes)
+
+outerMetaTypesWitness :: Property (MetaTypes l) -> OuterMetaTypesWitness l
+outerMetaTypesWitness (Property metatypes _ _ _ _) = OuterMetaTypesWitness metatypes
diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs
index f6fd15f1..2b38af0c 100644
--- a/src/Propellor/Exception.hs
+++ b/src/Propellor/Exception.hs
@@ -2,11 +2,11 @@
module Propellor.Exception where
-import qualified "MonadCatchIO-transformers" Control.Monad.CatchIO as M
-import Control.Exception
-
import Propellor.Types
import Propellor.Message
+import Utility.Exception
+
+import Control.Exception (IOException)
-- | Catches IO exceptions and returns FailedChange.
catchPropellor :: Propellor Result -> Propellor Result
@@ -15,4 +15,4 @@ catchPropellor a = either err return =<< tryPropellor a
err e = warningMessage (show e) >> return FailedChange
tryPropellor :: Propellor a -> Propellor (Either IOException a)
-tryPropellor = M.try
+tryPropellor = try
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
new file mode 100644
index 00000000..c3257b31
--- /dev/null
+++ b/src/Propellor/Git.hs
@@ -0,0 +1,28 @@
+module Propellor.Git where
+
+import Utility.Process
+import Utility.Exception
+import Utility.Directory
+
+import Control.Applicative
+import Prelude
+
+getCurrentBranch :: IO String
+getCurrentBranch = takeWhile (/= '\n')
+ <$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
+
+getCurrentBranchRef :: IO String
+getCurrentBranchRef = takeWhile (/= '\n')
+ <$> readProcess "git" ["symbolic-ref", "HEAD"]
+
+getCurrentGitSha1 :: String -> IO String
+getCurrentGitSha1 branchref = takeWhile (/= '\n')
+ <$> readProcess "git" ["show-ref", "--hash", branchref]
+
+hasOrigin :: IO Bool
+hasOrigin = catchDefaultIO False $ do
+ rs <- lines <$> readProcess "git" ["remote"]
+ return $ "origin" `elem` rs
+
+hasGitRepo :: IO Bool
+hasGitRepo = doesFileExist ".git/HEAD"
diff --git a/src/Propellor/Git/Config.hs b/src/Propellor/Git/Config.hs
new file mode 100644
index 00000000..837fc0de
--- /dev/null
+++ b/src/Propellor/Git/Config.hs
@@ -0,0 +1,49 @@
+module Propellor.Git.Config where
+
+import Propellor.Git
+import Utility.Process
+import Utility.Exception
+import Utility.SafeCommand
+import Utility.Monad
+
+import Control.Monad
+import Control.Applicative
+import Prelude
+
+getGitConfigValue :: String -> IO (Maybe String)
+getGitConfigValue key = do
+ value <- catchMaybeIO $
+ takeWhile (/= '\n')
+ <$> readProcess"git" ["config", key]
+ return $ case value of
+ Just v | not (null v) -> Just v
+ _ -> Nothing
+
+-- `git config --bool propellor.blah` outputs "false" if propellor.blah is unset
+-- i.e. the git convention is that the default value of any git-config setting
+-- is "false". So we don't need a Maybe Bool here.
+getGitConfigBool :: String -> IO Bool
+getGitConfigBool key = do
+ value <- catchMaybeIO $
+ takeWhile (/= '\n')
+ <$> readProcess "git" ["config", "--bool", key]
+ return $ case value of
+ Just "true" -> True
+ _ -> False
+
+setRepoUrl :: String -> IO ()
+setRepoUrl "" = return ()
+setRepoUrl url = do
+ subcmd <- ifM hasOrigin (pure "set-url", pure "add")
+ void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url]
+ -- same as --set-upstream-to, except origin branch
+ -- may not have been pulled yet
+ branch <- getCurrentBranch
+ let branchval s = "branch." ++ branch ++ "." ++ s
+ void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]
+ void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]
+
+getRepoUrl :: IO (Maybe String)
+getRepoUrl = getM getGitConfigValue urls
+ where
+ urls = ["remote.deploy.url", "remote.origin.url"]
diff --git a/src/Propellor/Git/VerifiedBranch.hs b/src/Propellor/Git/VerifiedBranch.hs
new file mode 100644
index 00000000..51fcb573
--- /dev/null
+++ b/src/Propellor/Git/VerifiedBranch.hs
@@ -0,0 +1,52 @@
+module Propellor.Git.VerifiedBranch where
+
+import Propellor.Base
+import Propellor.Git
+import Propellor.PrivData.Paths
+import Utility.FileMode
+
+{- To verify origin branch commit's signature, have to convince gpg
+ - to use our keyring.
+ - While running git log. Which has no way to pass options to gpg.
+ - Argh!
+ -}
+verifyOriginBranch :: String -> IO Bool
+verifyOriginBranch originbranch = do
+ let gpgconf = privDataDir </> "gpg.conf"
+ keyring <- privDataKeyring
+ writeFile gpgconf $ unlines
+ [ " keyring " ++ keyring
+ , "no-auto-check-trustdb"
+ ]
+ -- gpg is picky about perms
+ modifyFileMode privDataDir (removeModes otherGroupModes)
+ s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]
+ (Just [("GNUPGHOME", privDataDir)])
+ nukeFile $ privDataDir </> "trustdb.gpg"
+ nukeFile $ privDataDir </> "pubring.gpg"
+ nukeFile $ privDataDir </> "gpg.conf"
+ return (s == "U\n" || s == "G\n")
+
+-- Returns True if HEAD is changed by fetching and merging from origin.
+fetchOrigin :: IO Bool
+fetchOrigin = do
+ branchref <- getCurrentBranch
+ let originbranch = "origin" </> branchref
+
+ void $ actionMessage "Pull from central git repository" $
+ boolSystem "git" [Param "fetch"]
+
+ oldsha <- getCurrentGitSha1 branchref
+
+ keyring <- privDataKeyring
+ whenM (doesFileExist keyring) $
+ ifM (verifyOriginBranch originbranch)
+ ( do
+ putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
+ hFlush stdout
+ void $ boolSystem "git" [Param "merge", Param originbranch]
+ , warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
+ )
+
+ newsha <- getCurrentGitSha1 branchref
+ return $ oldsha /= newsha
diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
new file mode 100644
index 00000000..b825d743
--- /dev/null
+++ b/src/Propellor/Gpg.hs
@@ -0,0 +1,185 @@
+module Propellor.Gpg where
+
+import System.IO
+import Data.Maybe
+import Data.List.Utils
+import Control.Monad
+import Control.Applicative
+import Prelude
+
+import Propellor.PrivData.Paths
+import Propellor.Message
+import Propellor.Git.Config
+import Utility.SafeCommand
+import Utility.Process
+import Utility.Process.NonConcurrent
+import Utility.Monad
+import Utility.Misc
+import Utility.Tmp
+import Utility.FileSystemEncoding
+import Utility.Env
+import Utility.Directory
+
+type KeyId = String
+
+getGpgBin :: IO String
+getGpgBin = do
+ gitGpgBin <- getGitConfigValue "gpg.program"
+ case gitGpgBin of
+ Nothing -> getEnvDefault "GNUPGBIN" "gpg"
+ Just b -> return b
+
+-- Lists the keys in propellor's keyring.
+listPubKeys :: IO [KeyId]
+listPubKeys = do
+ keyring <- privDataKeyring
+ map fst <$> listKeys ("--list-public-keys" : useKeyringOpts keyring)
+
+listSecretKeys :: IO [(KeyId, String)]
+listSecretKeys = listKeys ["--list-secret-keys"]
+
+listKeys :: [String] -> IO [(KeyId, String)]
+listKeys ps = do
+ gpgbin <- getGpgBin
+ parse . lines <$> readProcess gpgbin listopts
+ where
+ listopts = ps ++ ["--with-colons"]
+ parse = mapMaybe (keyIdField . split ":")
+ keyIdField (t:_:_:_:f:_:_:_:_:n:_)
+ | t == "pub" || t == "sec" = Just (f, n)
+ keyIdField _ = Nothing
+
+useKeyringOpts :: FilePath -> [String]
+useKeyringOpts keyring =
+ [ "--options"
+ , "/dev/null"
+ , "--no-default-keyring"
+ , "--keyring", keyring
+ ]
+
+addKey :: KeyId -> IO ()
+addKey keyid = do
+ gpgbin <- getGpgBin
+ keyring <- privDataKeyring
+ exitBool =<< allM (uncurry actionMessage)
+ [ ("adding key to propellor's keyring", addkeyring keyring gpgbin)
+ , ("staging propellor's keyring", gitAdd keyring)
+ , ("updating encryption of any privdata", reencryptPrivData)
+ , ("configuring git commit signing to use key", gitconfig gpgbin)
+ , ("committing changes", gitCommitKeyRing "add-key")
+ ]
+ where
+ addkeyring keyring' gpgbin' = do
+ createDirectoryIfMissing True privDataDir
+ boolSystem "sh"
+ [ Param "-c"
+ , Param $ gpgbin' ++ " --export " ++ keyid ++ " | gpg " ++
+ unwords (useKeyringOpts keyring' ++ ["--import"])
+ ]
+
+ gitconfig gpgbin' = ifM (snd <$> processTranscript gpgbin' ["--list-secret-keys", keyid] Nothing)
+ ( boolSystem "git"
+ [ Param "config"
+ , Param "user.signingkey"
+ , Param keyid
+ ]
+ , do
+ warningMessage $ "Cannot find a secret key for key " ++ keyid ++ ", so not configuring git user.signingkey to use this key."
+ return True
+ )
+
+rmKey :: KeyId -> IO ()
+rmKey keyid = do
+ gpgbin <- getGpgBin
+ keyring <- privDataKeyring
+ exitBool =<< allM (uncurry actionMessage)
+ [ ("removing key from propellor's keyring", rmkeyring keyring gpgbin)
+ , ("staging propellor's keyring", gitAdd keyring)
+ , ("updating encryption of any privdata", reencryptPrivData)
+ , ("configuring git commit signing to not use key", gitconfig)
+ , ("committing changes", gitCommitKeyRing "rm-key")
+ ]
+ where
+ rmkeyring keyring' gpgbin' = boolSystem gpgbin' $
+ (map Param (useKeyringOpts keyring')) ++
+ [ Param "--batch"
+ , Param "--yes"
+ , Param "--delete-key", Param keyid
+ ]
+
+ gitconfig = ifM ((==) (keyid++"\n", True) <$> processTranscript "git" ["config", "user.signingkey"] Nothing)
+ ( boolSystem "git"
+ [ Param "config"
+ , Param "--unset"
+ , Param "user.signingkey"
+ ]
+ , return True
+ )
+
+reencryptPrivData :: IO Bool
+reencryptPrivData = do
+ f <- privDataFile
+ ifM (doesFileExist f)
+ ( do
+ gpgEncrypt f =<< gpgDecrypt f
+ gitAdd f
+ , return True
+ )
+
+gitAdd :: FilePath -> IO Bool
+gitAdd f = boolSystem "git"
+ [ Param "add"
+ , File f
+ ]
+
+gitCommitKeyRing :: String -> IO Bool
+gitCommitKeyRing action = do
+ keyring <- privDataKeyring
+ privdata <- privDataFile
+ -- Commit explicitly the keyring and privdata files, as other
+ -- changes may be staged by the user and shouldn't be committed.
+ tocommit <- filterM doesFileExist [ privdata, keyring]
+ gitCommit (Just ("propellor " ++ action)) (map File tocommit)
+
+-- Adds --gpg-sign if there's a keyring.
+gpgSignParams :: [CommandParam] -> IO [CommandParam]
+gpgSignParams ps = do
+ keyring <- privDataKeyring
+ ifM (doesFileExist keyring)
+ ( return (ps ++ [Param "--gpg-sign"])
+ , return ps
+ )
+
+-- Automatically sign the commit if there'a a keyring.
+gitCommit :: Maybe String -> [CommandParam] -> IO Bool
+gitCommit msg ps = do
+ let ps' = Param "commit" : ps ++
+ maybe [] (\m -> [Param "-m", Param m]) msg
+ ps'' <- gpgSignParams ps'
+ boolSystemNonConcurrent "git" ps''
+
+gpgDecrypt :: FilePath -> IO String
+gpgDecrypt f = do
+ gpgbin <- getGpgBin
+ ifM (doesFileExist f)
+ ( writeReadProcessEnv gpgbin ["--decrypt", f] Nothing Nothing (Just fileEncoding)
+ , return ""
+ )
+
+-- Encrypt file to all keys in propellor's keyring.
+gpgEncrypt :: FilePath -> String -> IO ()
+gpgEncrypt f s = do
+ gpgbin <- getGpgBin
+ keyids <- listPubKeys
+ let opts =
+ [ "--default-recipient-self"
+ , "--armor"
+ , "--encrypt"
+ , "--trust-model", "always"
+ ] ++ concatMap (\k -> ["--recipient", k]) keyids
+ encrypted <- writeReadProcessEnv gpgbin opts Nothing (Just writer) Nothing
+ viaTmp writeFile f encrypted
+ where
+ writer h = do
+ fileEncoding h
+ hPutStr h s
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index f44d1de3..b87369c3 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,9 +1,30 @@
-{-# LANGUAGE PackageImports #-}
-
-module Propellor.Info where
+{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
+
+module Propellor.Info (
+ osDebian,
+ osBuntish,
+ osFreeBSD,
+ setInfoProperty,
+ addInfoProperty,
+ pureInfoProperty,
+ pureInfoProperty',
+ askInfo,
+ getOS,
+ ipv4,
+ ipv6,
+ alias,
+ addDNS,
+ hostMap,
+ aliasMap,
+ findHost,
+ findHostNoAlias,
+ getAddresses,
+ hostAddresses,
+) where
import Propellor.Types
import Propellor.Types.Info
+import Propellor.Types.MetaTypes
import "mtl" Control.Monad.Reader
import qualified Data.Set as S
@@ -11,29 +32,89 @@ import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import Control.Applicative
+import Prelude
+
+-- | Adds info to a Property.
+--
+-- The new Property will include HasInfo in its metatypes.
+setInfoProperty
+ :: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
+ => Property metatypes
+ -> Info
+ -> Property (MetaTypes metatypes')
+setInfoProperty (Property _ d a oldi c) newi =
+ Property sing d a (oldi <> newi) c
+
+-- | Adds more info to a Property that already HasInfo.
+addInfoProperty
+ :: (IncludesInfo metatypes ~ 'True)
+ => Property metatypes
+ -> Info
+ -> Property metatypes
+addInfoProperty (Property t d a oldi c) newi =
+ Property t d a (oldi <> newi) c
+
+-- | Makes a property that does nothing but set some `Info`.
+pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike)
+pureInfoProperty desc v = pureInfoProperty' desc (toInfo v)
+
+pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike)
+pureInfoProperty' desc i = setInfoProperty p i
+ where
+ p :: Property UnixLike
+ p = property ("has " ++ desc) (return NoChange)
+
+-- | Gets a value from the host's Info.
+askInfo :: (IsInfo v) => Propellor v
+askInfo = asks (fromInfo . hostInfo)
+
+-- | Specifies that a host's operating system is Debian,
+-- and further indicates the suite and architecture.
+--
+-- This provides info for other Properties, so they can act
+-- conditionally on the details of the OS.
+--
+-- It also lets the type checker know that all the properties of the
+-- host must support Debian.
+--
+-- > & osDebian (Stable "jessie") "amd64"
+osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
+osDebian suite arch = tightenTargets $ os (System (Debian suite) arch)
-pureInfoProperty :: Desc -> Info -> Property
-pureInfoProperty desc = Property ("has " ++ desc) (return NoChange)
+-- | Specifies that a host's operating system is a well-known Debian
+-- derivative founded by a space tourist.
+--
+-- (The actual name of this distribution is not used in Propellor per
+-- <http://joeyh.name/blog/entry/trademark_nonsense/>)
+osBuntish :: Release -> Architecture -> Property (HasInfo + Buntish)
+osBuntish release arch = tightenTargets $ os (System (Buntish release) arch)
-askInfo :: (Info -> Val a) -> Propellor (Maybe a)
-askInfo f = asks (fromVal . f . hostInfo)
+-- | Specifies that a host's operating system is FreeBSD
+-- and further indicates the release and architecture.
+osFreeBSD :: FreeBSDRelease -> Architecture -> Property (HasInfo + FreeBSD)
+osFreeBSD release arch = tightenTargets $ os (System (FreeBSD release) arch)
-os :: System -> Property
-os system = pureInfoProperty ("Operating " ++ show system) $
- mempty { _os = Val system }
+os :: System -> Property (HasInfo + UnixLike)
+os system = pureInfoProperty ("Operating " ++ show system) (InfoVal system)
+-- Gets the operating system of a host, if it has been specified.
getOS :: Propellor (Maybe System)
-getOS = askInfo _os
+getOS = fromInfoVal <$> askInfo
--- | Indidate that a host has an A record in the DNS.
+-- | Indicate that a host has an A record in the DNS.
+--
+-- When propellor is used to deploy a DNS server for a domain,
+-- the hosts in the domain are found by looking for these
+-- and similar properites.
--
--- TODO check at run time if the host really has this address.
--- (Can't change the host's address, but as a sanity check.)
-ipv4 :: String -> Property
+-- When propellor --spin is used to deploy a host, it checks
+-- if the host's IP Property matches the DNS. If the DNS is missing or
+-- out of date, the host will instead be contacted directly by IP address.
+ipv4 :: String -> Property (HasInfo + UnixLike)
ipv4 = addDNS . Address . IPv4
--- | Indidate that a host has an AAAA record in the DNS.
-ipv6 :: String -> Property
+-- | Indicate that a host has an AAAA record in the DNS.
+ipv6 :: String -> Property (HasInfo + UnixLike)
ipv6 = addDNS . Address . IPv6
-- | Indicates another name for the host in the DNS.
@@ -42,16 +123,15 @@ ipv6 = addDNS . Address . IPv6
-- to use their address, rather than using a CNAME. This avoids various
-- problems with CNAMEs, and also means that when multiple hosts have the
-- same alias, a DNS round-robin is automatically set up.
-alias :: Domain -> Property
-alias d = pureInfoProperty ("alias " ++ d) $ mempty
- { _aliases = S.singleton d
+alias :: Domain -> Property (HasInfo + UnixLike)
+alias d = pureInfoProperty' ("alias " ++ d) $ mempty
+ `addInfo` toAliasesInfo [d]
-- A CNAME is added here, but the DNS setup code converts it to an
-- IP address when that makes sense.
- , _dns = S.singleton $ CNAME $ AbsDomain d
- }
+ `addInfo` (toDnsInfo $ S.singleton $ CNAME $ AbsDomain d)
-addDNS :: Record -> Property
-addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r }
+addDNS :: Record -> Property (HasInfo + UnixLike)
+addDNS r = pureInfoProperty (rdesc r) (toDnsInfo (S.singleton r))
where
rdesc (CNAME d) = unwords ["alias", ddesc d]
rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
@@ -60,27 +140,23 @@ addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r }
rdesc (NS d) = unwords ["NS", ddesc d]
rdesc (TXT s) = unwords ["TXT", s]
rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
+ rdesc (SSHFP x y s) = unwords ["SSHFP", show x, show y, s]
+ rdesc (INCLUDE f) = unwords ["$INCLUDE", f]
+ rdesc (PTR x) = unwords ["PTR", x]
ddesc (AbsDomain domain) = domain
ddesc (RelDomain domain) = domain
ddesc RootDomain = "@"
-sshPubKey :: String -> Property
-sshPubKey k = pureInfoProperty ("ssh pubkey known") $
- mempty { _sshPubKey = Val k }
-
-getSshPubKey :: Propellor (Maybe String)
-getSshPubKey = askInfo _sshPubKey
-
hostMap :: [Host] -> M.Map HostName Host
-hostMap l = M.fromList $ zip (map hostName l) l
+hostMap l = M.fromList $ zip (map hostName l) l
aliasMap :: [Host] -> M.Map HostName Host
aliasMap = M.fromList . concat .
- map (\h -> map (\aka -> (aka, h)) $ S.toList $ _aliases $ hostInfo h)
+ map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ fromInfo $ hostInfo h)
findHost :: [Host] -> HostName -> Maybe Host
-findHost l hn = maybe (findAlias l hn) Just (findHostNoAlias l hn)
+findHost l hn = (findHostNoAlias l hn) <|> (findAlias l hn)
findHostNoAlias :: [Host] -> HostName -> Maybe Host
findHostNoAlias l hn = M.lookup hn (hostMap l)
@@ -89,9 +165,7 @@ findAlias :: [Host] -> HostName -> Maybe Host
findAlias l hn = M.lookup hn (aliasMap l)
getAddresses :: Info -> [IPAddr]
-getAddresses = mapMaybe getIPAddr . S.toList . _dns
+getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . fromInfo
hostAddresses :: HostName -> [Host] -> [IPAddr]
-hostAddresses hn hosts = case hostInfo <$> findHost hosts hn of
- Nothing -> []
- Just info -> mapMaybe getIPAddr $ S.toList $ _dns info
+hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)
diff --git a/src/Propellor/Location.hs b/src/Propellor/Location.hs
new file mode 100644
index 00000000..3fc09538
--- /dev/null
+++ b/src/Propellor/Location.hs
@@ -0,0 +1,5 @@
+module Propellor.Location where
+
+-- | This is where propellor installs itself when deploying a host.
+localdir :: FilePath
+localdir = "/usr/local/propellor"
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index afbed1ca..32625e6a 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -1,66 +1,149 @@
-{-# LANGUAGE PackageImports #-}
+-- | This module handles all display of output to the console when
+-- propellor is ensuring Properties.
+--
+-- When two threads both try to display a message concurrently,
+-- the messages will be displayed sequentially.
-module Propellor.Message where
+module Propellor.Message (
+ getMessageHandle,
+ isConsole,
+ forceConsole,
+ actionMessage,
+ actionMessageOn,
+ warningMessage,
+ infoMessage,
+ errorMessage,
+ processChainOutput,
+ messagesDone,
+ createProcessConcurrent,
+ withConcurrentOutput,
+) where
import System.Console.ANSI
import System.IO
-import System.Log.Logger
-import "mtl" Control.Monad.Reader
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import System.IO.Unsafe (unsafePerformIO)
+import Control.Concurrent
+import System.Console.Concurrent
+import Control.Applicative
+import Prelude
import Propellor.Types
+import Utility.PartialPrelude
+import Utility.Monad
+import Utility.Exception
+
+data MessageHandle = MessageHandle
+ { isConsole :: Bool
+ }
+
+-- | A shared global variable for the MessageHandle.
+{-# NOINLINE globalMessageHandle #-}
+globalMessageHandle :: MVar MessageHandle
+globalMessageHandle = unsafePerformIO $
+ newMVar =<< MessageHandle
+ <$> catchDefaultIO False (hIsTerminalDevice stdout)
+
+-- | Gets the global MessageHandle.
+getMessageHandle :: IO MessageHandle
+getMessageHandle = readMVar globalMessageHandle
+
+-- | Force console output. This can be used when stdout is not directly
+-- connected to a console, but is eventually going to be displayed at a
+-- console.
+forceConsole :: IO ()
+forceConsole = modifyMVar_ globalMessageHandle $ \mh ->
+ pure (mh { isConsole = True })
+
+whenConsole :: String -> IO String
+whenConsole s = ifM (isConsole <$> getMessageHandle)
+ ( pure s
+ , pure ""
+ )
-- | Shows a message while performing an action, with a colored status
-- display.
-actionMessage :: (MonadIO m, ActionResult r) => Desc -> m r -> m r
+actionMessage :: (MonadIO m, MonadMask m, ActionResult r) => Desc -> m r -> m r
actionMessage = actionMessage' Nothing
-- | Shows a message while performing an action on a specified host,
-- with a colored status display.
-actionMessageOn :: (MonadIO m, ActionResult r) => HostName -> Desc -> m r -> m r
+actionMessageOn :: (MonadIO m, MonadMask m, ActionResult r) => HostName -> Desc -> m r -> m r
actionMessageOn = actionMessage' . Just
-actionMessage' :: (MonadIO m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r
+actionMessage' :: (MonadIO m, MonadMask m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r
actionMessage' mhn desc a = do
- liftIO $ do
- setTitle $ "propellor: " ++ desc
- hFlush stdout
+ liftIO $ outputConcurrent
+ =<< whenConsole (setTitleCode $ "propellor: " ++ desc)
r <- a
- liftIO $ do
- setTitle "propellor: running"
- showhn mhn
- putStr $ desc ++ " ... "
- let (msg, intensity, color) = getActionResult r
- colorLine intensity color msg
- hFlush stdout
+ liftIO $ outputConcurrent . concat =<< sequence
+ [ whenConsole $
+ setTitleCode "propellor: running"
+ , showhn mhn
+ , pure $ desc ++ " ... "
+ , let (msg, intensity, color) = getActionResult r
+ in colorLine intensity color msg
+ ]
return r
where
- showhn Nothing = return ()
- showhn (Just hn) = do
- setSGR [SetColor Foreground Dull Cyan]
- putStr (hn ++ " ")
- setSGR []
+ showhn Nothing = return ""
+ showhn (Just hn) = concat <$> sequence
+ [ whenConsole $
+ setSGRCode [SetColor Foreground Dull Cyan]
+ , pure (hn ++ " ")
+ , whenConsole $
+ setSGRCode []
+ ]
warningMessage :: MonadIO m => String -> m ()
-warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s
+warningMessage s = liftIO $
+ outputConcurrent =<< colorLine Vivid Magenta ("** warning: " ++ s)
-colorLine :: ColorIntensity -> Color -> String -> IO ()
-colorLine intensity color msg = do
- setSGR [SetColor Foreground intensity color]
- putStr msg
- setSGR []
+infoMessage :: MonadIO m => [String] -> m ()
+infoMessage ls = liftIO $ outputConcurrent $ concatMap (++ "\n") ls
+
+errorMessage :: MonadIO m => String -> m a
+errorMessage s = liftIO $ do
+ outputConcurrent =<< colorLine Vivid Red ("** error: " ++ s)
+ error "Cannot continue!"
+
+colorLine :: ColorIntensity -> Color -> String -> IO String
+colorLine intensity color msg = concat <$> sequence
+ [ whenConsole $
+ setSGRCode [SetColor Foreground intensity color]
+ , pure msg
+ , whenConsole $
+ setSGRCode []
-- Note this comes after the color is reset, so that
-- the color set and reset happen in the same line.
- putStrLn ""
- hFlush stdout
+ , pure "\n"
+ ]
-errorMessage :: String -> IO a
-errorMessage s = do
- liftIO $ colorLine Vivid Red $ "** error: " ++ s
- error "Cannot continue!"
+-- | Reads and displays each line from the Handle, except for the last line
+-- which is a Result.
+processChainOutput :: Handle -> IO Result
+processChainOutput h = go Nothing
+ where
+ go lastline = do
+ v <- catchMaybeIO (hGetLine h)
+ case v of
+ Nothing -> case lastline of
+ Nothing -> do
+ return FailedChange
+ Just l -> case readish l of
+ Just r -> pure r
+ Nothing -> do
+ outputConcurrent (l ++ "\n")
+ return FailedChange
+ Just s -> do
+ outputConcurrent $
+ maybe "" (\l -> if null l then "" else l ++ "\n") lastline
+ go (Just s)
--- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1
-debug :: [String] -> IO ()
-debug = debugM "propellor" . unwords
+-- | Called when all messages about properties have been printed.
+messagesDone :: IO ()
+messagesDone = outputConcurrent
+ =<< whenConsole (setTitleCode "propellor: done")
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index f55ab74c..2e9cdbab 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -1,43 +1,73 @@
{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
-module Propellor.PrivData where
+module Propellor.PrivData (
+ withPrivData,
+ withSomePrivData,
+ addPrivData,
+ setPrivData,
+ unsetPrivData,
+ unsetPrivDataUnused,
+ dumpPrivData,
+ editPrivData,
+ filterPrivData,
+ listPrivDataFields,
+ makePrivDataDir,
+ decryptPrivData,
+ readPrivData,
+ readPrivDataFile,
+ PrivMap,
+ PrivInfo,
+ forceHostContext,
+) where
-import Control.Applicative
-import System.FilePath
import System.IO
-import System.Directory
import Data.Maybe
-import Data.Monoid
import Data.List
+import Data.Typeable
import Control.Monad
import Control.Monad.IfElse
import "mtl" Control.Monad.Reader
import qualified Data.Map as M
import qualified Data.Set as S
+import qualified Data.ByteString.Lazy as L
+import Control.Applicative
+import Data.Monoid
+import Prelude
import Propellor.Types
+import Propellor.Types.PrivData
+import Propellor.Types.MetaTypes
import Propellor.Types.Info
import Propellor.Message
import Propellor.Info
+import Propellor.Gpg
+import Propellor.PrivData.Paths
import Utility.Monad
import Utility.PartialPrelude
import Utility.Exception
-import Utility.Process
import Utility.Tmp
import Utility.SafeCommand
+import Utility.Process.NonConcurrent
import Utility.Misc
import Utility.FileMode
import Utility.Env
import Utility.Table
+import Utility.FileSystemEncoding
+import Utility.Directory
-- | Allows a Property to access the value of a specific PrivDataField,
--- for use in a specific Context.
+-- for use in a specific Context or HostContext.
--
-- Example use:
--
-- > withPrivData (PrivFile pemfile) (Context "joeyh.name") $ \getdata ->
-- > property "joeyh.name ssl cert" $ getdata $ \privdata ->
--- > liftIO $ writeFile pemfile privdata
+-- > liftIO $ writeFile pemfile (privDataVal privdata)
-- > where pemfile = "/etc/ssl/certs/web.pem"
--
-- Note that if the value is not available, the action is not run
@@ -48,22 +78,73 @@ import Utility.Table
-- being used, which is necessary to ensure that the privdata is sent to
-- the remote host by propellor.
withPrivData
- :: PrivDataField
- -> Context
- -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
- -> Property
-withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a ->
- maybe missing a =<< liftIO (getLocalPrivData field context)
+ ::
+ ( IsContext c
+ , IsPrivDataSource s
+ , IncludesInfo metatypes ~ 'True
+ )
+ => s
+ -> c
+ -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property metatypes)
+ -> Property metatypes
+withPrivData s = withPrivData' snd [s]
+
+-- Like withPrivData, but here any one of a list of PrivDataFields can be used.
+withSomePrivData
+ ::
+ ( IsContext c
+ , IsPrivDataSource s
+ , IncludesInfo metatypes ~ 'True
+ )
+ => [s]
+ -> c
+ -> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property metatypes)
+ -> Property metatypes
+withSomePrivData = withPrivData' id
+
+withPrivData'
+ ::
+ ( IsContext c
+ , IsPrivDataSource s
+ , IncludesInfo metatypes ~ 'True
+ )
+ => ((PrivDataField, PrivData) -> v)
+ -> [s]
+ -> c
+ -> (((v -> Propellor Result) -> Propellor Result) -> Property metatypes)
+ -> Property metatypes
+withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
+ maybe missing (a . feed) =<< getM get fieldlist
where
- missing = liftIO $ do
- warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")"
- putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"
+ get field = do
+ context <- mkHostContext hc <$> asks hostName
+ maybe Nothing (\privdata -> Just (field, privdata))
+ <$> liftIO (getLocalPrivData field context)
+ missing = do
+ Context cname <- mkHostContext hc <$> asks hostName
+ warningMessage $ "Missing privdata " ++ intercalate " or " fieldnames ++ " (for " ++ cname ++ ")"
+ infoMessage $
+ "Fix this by running:" :
+ showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
return FailedChange
- addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, context) } }
+ addinfo p = p `addInfoProperty` (toInfo privset)
+ privset = PrivInfo $ S.fromList $
+ map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
+ fieldnames = map show fieldlist
+ fieldlist = map privDataField srclist
+ hc = asHostContext c
+
+showSet :: [(PrivDataField, Context, Maybe PrivDataSourceDesc)] -> [String]
+showSet = concatMap go
+ where
+ go (f, Context c, md) = catMaybes
+ [ Just $ " propellor --set '" ++ show f ++ "' '" ++ c ++ "' \\"
+ , maybe Nothing (\d -> Just $ " " ++ d) md
+ , Just ""
+ ]
-addPrivDataField :: (PrivDataField, Context) -> Property
-addPrivDataField v = pureInfoProperty (show v) $
- mempty { _privDataFields = S.singleton v }
+addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property (HasInfo + UnixLike)
+addPrivData v = pureInfoProperty (show v) (PrivInfo (S.singleton v))
{- Gets the requested field's value, in the specified context if it's
- available, from the host's local privdata cache. -}
@@ -73,103 +154,143 @@ getLocalPrivData field context =
where
localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal
-type PrivMap = M.Map (PrivDataField, Context) PrivData
+type PrivMap = M.Map (PrivDataField, Context) String
-{- Get only the set of PrivData that the Host's Info says it uses. -}
+-- | Get only the set of PrivData that the Host's Info says it uses.
filterPrivData :: Host -> PrivMap -> PrivMap
filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
where
- used = _privDataFields $ hostInfo host
+ used = S.map (\(f, _, c) -> (f, mkHostContext c (hostName host))) $
+ fromPrivInfo $ fromInfo $ hostInfo host
getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
-getPrivData field context = M.lookup (field, context)
+getPrivData field context m = do
+ s <- M.lookup (field, context) m
+ return (PrivData s)
setPrivData :: PrivDataField -> Context -> IO ()
setPrivData field context = do
putStrLn "Enter private data on stdin; ctrl-D when done:"
- setPrivDataTo field context =<< hGetContentsStrict stdin
+ fileEncoding stdin
+ setPrivDataTo field context . PrivData =<< hGetContentsStrict stdin
+
+unsetPrivData :: PrivDataField -> Context -> IO ()
+unsetPrivData field context = do
+ modifyPrivData $ M.delete (field, context)
+ descUnset field context
+
+descUnset :: PrivDataField -> Context -> IO ()
+descUnset field context =
+ putStrLn $ "Private data unset: " ++ show field ++ " " ++ show context
+
+unsetPrivDataUnused :: [Host] -> IO ()
+unsetPrivDataUnused hosts = do
+ deleted <- modifyPrivData' $ \m ->
+ let (keep, del) = M.partitionWithKey (\k _ -> k `M.member` usedby) m
+ in (keep, M.keys del)
+ mapM_ (uncurry descUnset) deleted
+ where
+ usedby = mkUsedByMap hosts
dumpPrivData :: PrivDataField -> Context -> IO ()
-dumpPrivData field context =
- maybe (error "Requested privdata is not set.") putStrLn
+dumpPrivData field context = do
+ maybe (error "Requested privdata is not set.")
+ (L.hPut stdout . privDataByteString)
=<< (getPrivData field context <$> decryptPrivData)
editPrivData :: PrivDataField -> Context -> IO ()
editPrivData field context = do
v <- getPrivData field context <$> decryptPrivData
- v' <- withTmpFile "propellorXXXX" $ \f h -> do
- hClose h
- maybe noop (writeFileProtected f) v
+ v' <- withTmpFile "propellorXXXX" $ \f th -> do
+ hClose th
+ maybe noop (\p -> writeFileProtected' f (`L.hPut` privDataByteString p)) v
editor <- getEnvDefault "EDITOR" "vi"
- unlessM (boolSystem editor [File f]) $
+ unlessM (boolSystemNonConcurrent editor [File f]) $
error "Editor failed; aborting."
- readFile f
+ PrivData <$> readFile f
setPrivDataTo field context v'
listPrivDataFields :: [Host] -> IO ()
listPrivDataFields hosts = do
m <- decryptPrivData
- showtable "Currently set data:" $
- map mkrow (M.keys m)
- showtable "Data that would be used if set:" $
- map mkrow (M.keys $ M.difference wantedmap m)
+
+ section "Currently set data:"
+ showtable $ map mkrow (M.keys m)
+ let missing = M.keys $ M.difference wantedmap m
+
+ unless (null missing) $ do
+ section "Missing data that would be used if set:"
+ showtable $ map mkrow missing
+
+ section "How to set missing data:"
+ mapM_ putStrLn $ showSet $
+ map (\(f, c) -> (f, c, join $ M.lookup (f, c) descmap)) missing
where
header = ["Field", "Context", "Used by"]
- mkrow k@(field, (Context context)) =
+ mkrow k@(field, Context context) =
[ shellEscape $ show field
, shellEscape context
, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby
]
- mkhostmap host = M.fromList $ map (\k -> (k, [hostName host])) $
- S.toList $ _privDataFields $ hostInfo host
- usedby = M.unionsWith (++) $ map mkhostmap hosts
+ usedby = mkUsedByMap hosts
wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")
- showtable desc rows = do
- putStrLn $ "\n" ++ desc
+ descmap = M.unions $ map (`mkPrivDataMap` id) hosts
+ section desc = putStrLn $ "\n" ++ desc
+ showtable rows = do
putStr $ unlines $ formatTable $ tableWithHeader header rows
+mkUsedByMap :: [Host] -> M.Map (PrivDataField, Context) [HostName]
+mkUsedByMap = M.unionsWith (++) . map (\h -> mkPrivDataMap h $ const [hostName h])
+
+mkPrivDataMap :: Host -> (Maybe PrivDataSourceDesc -> a) -> M.Map (PrivDataField, Context) a
+mkPrivDataMap host mkv = M.fromList $
+ map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d))
+ (S.toList $ fromPrivInfo $ fromInfo $ hostInfo host)
+
setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
-setPrivDataTo field context value = do
- makePrivDataDir
- m <- decryptPrivData
- let m' = M.insert (field, context) (chomp value) m
- gpgEncrypt privDataFile (show m')
+setPrivDataTo field context (PrivData value) = do
+ modifyPrivData set
putStrLn "Private data set."
- void $ boolSystem "git" [Param "add", File privDataFile]
where
- chomp s
- | end s == "\n" = chomp (beginning s)
- | otherwise = s
+ set = M.insert (field, context) value
+
+modifyPrivData :: (PrivMap -> PrivMap) -> IO ()
+modifyPrivData f = modifyPrivData' (\m -> (f m, ()))
+
+modifyPrivData' :: (PrivMap -> (PrivMap, a)) -> IO a
+modifyPrivData' f = do
+ makePrivDataDir
+ m <- decryptPrivData
+ let (m', r) = f m
+ privdata <- privDataFile
+ gpgEncrypt privdata (show m')
+ void $ boolSystem "git" [Param "add", File privdata]
+ return r
decryptPrivData :: IO PrivMap
-decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile
+decryptPrivData = readPrivData <$> (gpgDecrypt =<< privDataFile)
-makePrivDataDir :: IO ()
-makePrivDataDir = createDirectoryIfMissing False privDataDir
+readPrivData :: String -> PrivMap
+readPrivData = fromMaybe M.empty . readish
-privDataDir :: FilePath
-privDataDir = "privdata"
+readPrivDataFile :: FilePath -> IO PrivMap
+readPrivDataFile f = readPrivData <$> readFileStrictAnyEncoding f
-privDataFile :: FilePath
-privDataFile = privDataDir </> "privdata.gpg"
+makePrivDataDir :: IO ()
+makePrivDataDir = createDirectoryIfMissing False privDataDir
-privDataLocal :: FilePath
-privDataLocal = privDataDir </> "local"
+newtype PrivInfo = PrivInfo
+ { fromPrivInfo :: S.Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext) }
+ deriving (Eq, Ord, Show, Typeable, Monoid)
-gpgDecrypt :: FilePath -> IO String
-gpgDecrypt f = ifM (doesFileExist f)
- ( readProcess "gpg" ["--decrypt", f]
- , return ""
- )
+-- PrivInfo is propagated out of containers, so that propellor can see which
+-- hosts need it.
+instance IsInfo PrivInfo where
+ propagateInfo _ = True
-gpgEncrypt :: FilePath -> String -> IO ()
-gpgEncrypt f s = do
- encrypted <- writeReadProcessEnv "gpg"
- [ "--default-recipient-self"
- , "--armor"
- , "--encrypt"
- ]
- Nothing
- (Just $ flip hPutStr s)
- Nothing
- viaTmp writeFile f encrypted
+-- | Sets the context of any privdata that uses HostContext to the
+-- provided name.
+forceHostContext :: String -> PrivInfo -> PrivInfo
+forceHostContext name i = PrivInfo $ S.map go (fromPrivInfo i)
+ where
+ go (f, d, HostContext ctx) = (f, d, HostContext (const $ ctx name))
diff --git a/src/Propellor/PrivData/Paths.hs b/src/Propellor/PrivData/Paths.hs
new file mode 100644
index 00000000..7410370b
--- /dev/null
+++ b/src/Propellor/PrivData/Paths.hs
@@ -0,0 +1,31 @@
+module Propellor.PrivData.Paths where
+
+import Utility.Exception
+import System.FilePath
+import Control.Applicative
+import Prelude
+
+privDataDir :: FilePath
+privDataDir = "privdata"
+
+privDataFile :: IO FilePath
+privDataFile = allowRelocate $ privDataDir </> "privdata.gpg"
+
+privDataKeyring :: IO FilePath
+privDataKeyring = allowRelocate $ privDataDir </> "keyring.gpg"
+
+privDataLocal :: FilePath
+privDataLocal = privDataDir </> "local"
+
+privDataRelay :: String -> FilePath
+privDataRelay host = privDataDir </> "relay" </> host
+
+-- Allow relocating files in privdata, by checking for a file
+-- privdata/relocate, which contains the path to a subdirectory that
+-- contains the files.
+allowRelocate :: FilePath -> IO FilePath
+allowRelocate f = reloc . lines
+ <$> catchDefaultIO "" (readFile (privDataDir </> "relocate"))
+ where
+ reloc (p:_) | not (null p) = privDataDir </> p </> takeFileName f
+ reloc _ = f
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
new file mode 100644
index 00000000..fcac60bf
--- /dev/null
+++ b/src/Propellor/PropAccum.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DataKinds #-}
+
+module Propellor.PropAccum
+ ( host
+ , Props(..)
+ , props
+ , (&)
+ , (&^)
+ , (!)
+ ) where
+
+import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
+import Propellor.Property
+
+import Data.Monoid
+import Prelude
+
+-- | Defines a host and its properties.
+--
+-- > host "example.com" $ props
+-- > & someproperty
+-- > ! oldproperty
+-- > & otherproperty
+host :: HostName -> Props metatypes -> Host
+host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
+
+-- | Start accumulating a list of properties.
+--
+-- Properties can be added to it using `(&)` etc.
+props :: Props UnixLike
+props = Props []
+
+infixl 1 &
+infixl 1 &^
+infixl 1 !
+
+type family GetMetaTypes x
+type instance GetMetaTypes (Property (MetaTypes t)) = MetaTypes t
+type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t
+
+-- | Adds a property to a Props.
+--
+-- Can add Properties and RevertableProperties
+(&)
+ ::
+ ( IsProp p
+ , MetaTypes y ~ GetMetaTypes p
+ , CheckCombinable x y ~ 'CanCombine
+ )
+ => Props (MetaTypes x)
+ -> p
+ -> Props (MetaTypes (Combine x y))
+Props c & p = Props (c ++ [toChildProperty p])
+
+-- | Adds a property before any other properties.
+(&^)
+ ::
+ ( IsProp p
+ , MetaTypes y ~ GetMetaTypes p
+ , CheckCombinable x y ~ 'CanCombine
+ )
+ => Props (MetaTypes x)
+ -> p
+ -> Props (MetaTypes (Combine x y))
+Props c &^ p = Props (toChildProperty p : c)
+
+-- | Adds a property in reverted form.
+(!)
+ :: (CheckCombinable x z ~ 'CanCombine)
+ => Props (MetaTypes x)
+ -> RevertableProperty (MetaTypes y) (MetaTypes z)
+ -> Props (MetaTypes (Combine x z))
+Props c ! p = Props (c ++ [toChildProperty (revert p)])
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 4b957317..af36ed58 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -1,58 +1,80 @@
{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
-module Propellor.Property where
+module Propellor.Property (
+ -- * Property combinators
+ requires
+ , before
+ , onChange
+ , onChangeFlagOnFail
+ , flagFile
+ , flagFile'
+ , check
+ , fallback
+ , revert
+ -- * Property descriptions
+ , describe
+ , (==>)
+ -- * Constructing properties
+ , Propellor
+ , property
+ , property'
+ , OuterMetaTypesWitness
+ , ensureProperty
+ , pickOS
+ , withOS
+ , unsupportedOS
+ , unsupportedOS'
+ , makeChange
+ , noChange
+ , doNothing
+ , endAction
+ -- * Property result checking
+ , UncheckedProperty
+ , unchecked
+ , changesFile
+ , changesFileContent
+ , isNewerThan
+ , checkResult
+ , Checkable
+ , assume
+) where
-import System.Directory
+import System.FilePath
import Control.Monad
import Data.Monoid
import Control.Monad.IfElse
-import "mtl" Control.Monad.Reader
+import "mtl" Control.Monad.RWS.Strict
+import System.Posix.Files
+import qualified Data.Hash.MD5 as MD5
+import Data.List
+import Control.Applicative
+import Prelude
import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.ResultCheck
+import Propellor.Types.MetaTypes
+import Propellor.Types.Singletons
import Propellor.Info
-import Propellor.Engine
+import Propellor.EnsureProperty
+import Utility.Exception
import Utility.Monad
-import System.FilePath
-
--- Constructs a Property.
-property :: Desc -> Propellor Result -> Property
-property d s = Property d s mempty
-
--- | Combines a list of properties, resulting in a single property
--- that when run will run each property in the list in turn,
--- and print out the description of each as it's run. Does not stop
--- on failure; does propigate overall success/failure.
-propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = Property desc (ensureProperties ps) (combineInfos ps)
-
--- | Combines a list of properties, resulting in one property that
--- ensures each in turn. Does not stop on failure; does propigate
--- overall success/failure.
-combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = Property desc (go ps NoChange) (combineInfos ps)
- where
- go [] rs = return rs
- go (l:ls) rs = do
- r <- ensureProperty l
- case r of
- FailedChange -> return FailedChange
- _ -> go ls (r <> rs)
-
--- | Combines together two properties, resulting in one property
--- that ensures the first, and if the first succeeds, ensures the second.
--- The property uses the description of the first property.
-before :: Property -> Property -> Property
-p1 `before` p2 = p2 `requires` p1
- `describe` (propertyDesc p1)
+import Utility.Misc
+import Utility.Directory
-- | Makes a perhaps non-idempotent Property be idempotent by using a flag
-- file to indicate whether it has run before.
-- Use with caution.
-flagFile :: Property -> FilePath -> Property
+flagFile :: Property i -> FilePath -> Property i
flagFile p = flagFile' p . return
-flagFile' :: Property -> IO FilePath -> Property
-flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
+flagFile' :: Property i -> IO FilePath -> Property i
+flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
flagfile <- liftIO getflagfile
go satisfy flagfile =<< liftIO (doesFileExist flagfile)
where
@@ -65,107 +87,270 @@ flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
writeFile flagfile ""
return r
---- | Whenever a change has to be made for a Property, causes a hook
+-- | Indicates that the first property depends on the second,
+-- so before the first is ensured, the second must be ensured.
+--
+-- The combined property uses the description of the first property.
+requires :: Combines x y => x -> y -> CombinedType x y
+requires = combineWith
+ -- Run action of y, then x
+ (flip (<>))
+ -- When reverting, run in reverse order.
+ (<>)
+
+-- | Combines together two properties, resulting in one property
+-- that ensures the first, and if the first succeeds, ensures the second.
+--
+-- The combined property uses the description of the first property.
+before :: Combines x y => x -> y -> CombinedType x y
+before = combineWith
+ -- Run action of x, then y
+ (<>)
+ -- When reverting, run in reverse order.
+ (flip (<>))
+
+-- | Whenever a change has to be made for a Property, causes a hook
-- Property to also be run, but not otherwise.
-onChange :: Property -> Property -> Property
-p `onChange` hook = Property (propertyDesc p) satisfy (combineInfo p hook)
+onChange
+ :: (Combines x y)
+ => x
+ -> y
+ -> CombinedType x y
+onChange = combineWith combiner revertcombiner
where
- satisfy = do
- r <- ensureProperty p
+ combiner p hook = do
+ r <- p
case r of
MadeChange -> do
- r' <- ensureProperty hook
+ r' <- hook
return $ r <> r'
_ -> return r
+ revertcombiner = (<>)
+
+-- | Same as `onChange` except that if property y fails, a flag file
+-- is generated. On next run, if the flag file is present, property y
+-- is executed even if property x doesn't change.
+--
+-- With `onChange`, if y fails, the property x `onChange` y returns
+-- `FailedChange`. But if this property is applied again, it returns
+-- `NoChange`. This behavior can cause trouble...
+onChangeFlagOnFail
+ :: (Combines x y)
+ => FilePath
+ -> x
+ -> y
+ -> CombinedType x y
+onChangeFlagOnFail flagfile = combineWith combiner revertcombiner
+ where
+ combiner s1 s2 = do
+ r1 <- s1
+ case r1 of
+ MadeChange -> flagFailed s2
+ _ -> ifM (liftIO $ doesFileExist flagfile)
+ (flagFailed s2
+ , return r1
+ )
+ revertcombiner = (<>)
+ flagFailed s = do
+ r <- s
+ liftIO $ case r of
+ FailedChange -> createFlagFile
+ _ -> removeFlagFile
+ return r
+ createFlagFile = unlessM (doesFileExist flagfile) $ do
+ createDirectoryIfMissing True (takeDirectory flagfile)
+ writeFile flagfile ""
+ removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile
-(==>) :: Desc -> Property -> Property
+-- | Changes the description of a property.
+describe :: IsProp p => p -> Desc -> p
+describe = setDesc
+
+-- | Alias for @flip describe@
+(==>) :: IsProp (Property i) => Desc -> Property i -> Property i
(==>) = flip describe
infixl 1 ==>
--- | Makes a Property only need to do anything when a test succeeds.
-check :: IO Bool -> Property -> Property
-check c p = adjustProperty p $ \satisfy -> ifM (liftIO c)
- ( satisfy
- , return NoChange
- )
+-- | Tries the first property, but if it fails to work, instead uses
+-- the second.
+fallback :: (Combines p1 p2) => p1 -> p2 -> CombinedType p1 p2
+fallback = combineWith combiner revertcombiner
+ where
+ combiner a1 a2 = do
+ r <- a1
+ if r == FailedChange
+ then a2
+ else return r
+ revertcombiner = (<>)
--- | Marks a Property as trivial. It can only return FailedChange or
--- NoChange.
---
--- Useful when it's just as expensive to check if a change needs
--- to be made as it is to just idempotently assure the property is
--- satisfied. For example, chmodding a file.
-trivial :: Property -> Property
-trivial p = adjustProperty p $ \satisfy -> do
- r <- satisfy
- if r == MadeChange
- then return NoChange
- else return r
-
-doNothing :: Property
-doNothing = property "noop property" noChange
+-- | Indicates that a Property may change a particular file. When the file
+-- is modified in any way (including changing its permissions or mtime),
+-- the property will return MadeChange instead of NoChange.
+changesFile :: Checkable p i => p i -> FilePath -> Property i
+changesFile p f = checkResult getstat comparestat p
+ where
+ getstat = catchMaybeIO $ getSymbolicLinkStatus f
+ comparestat oldstat = do
+ newstat <- getstat
+ return $ if samestat oldstat newstat then NoChange else MadeChange
+ samestat Nothing Nothing = True
+ samestat (Just a) (Just b) = and
+ -- everything except for atime
+ [ deviceID a == deviceID b
+ , fileID a == fileID b
+ , fileMode a == fileMode b
+ , fileOwner a == fileOwner b
+ , fileGroup a == fileGroup b
+ , specialDeviceID a == specialDeviceID b
+ , fileSize a == fileSize b
+ , modificationTimeHiRes a == modificationTimeHiRes b
+ , isBlockDevice a == isBlockDevice b
+ , isCharacterDevice a == isCharacterDevice b
+ , isNamedPipe a == isNamedPipe b
+ , isRegularFile a == isRegularFile b
+ , isDirectory a == isDirectory b
+ , isSymbolicLink a == isSymbolicLink b
+ , isSocket a == isSocket b
+ ]
+ samestat _ _ = False
--- | Makes a property that is satisfied differently depending on the host's
--- operating system.
---
--- Note that the operating system may not be declared for some hosts.
-withOS :: Desc -> (Maybe System -> Propellor Result) -> Property
-withOS desc a = property desc $ a =<< getOS
-
-boolProperty :: Desc -> IO Bool -> Property
-boolProperty desc a = property desc $ ifM (liftIO a)
- ( return MadeChange
- , return FailedChange
- )
-
--- | Undoes the effect of a property.
-revert :: RevertableProperty -> RevertableProperty
-revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
+-- | Like `changesFile`, but compares the content of the file.
+-- Changes to mtime etc that do not change file content are treated as
+-- NoChange.
+changesFileContent :: Checkable p i => p i -> FilePath -> Property i
+changesFileContent p f = checkResult getmd5 comparemd5 p
+ where
+ getmd5 = catchMaybeIO $ MD5.md5 . MD5.Str <$> readFileStrictAnyEncoding f
+ comparemd5 oldmd5 = do
+ newmd5 <- getmd5
+ return $ if oldmd5 == newmd5 then NoChange else MadeChange
--- | Starts accumulating the properties of a Host.
+-- | Determines if the first file is newer than the second file.
--
--- > host "example.com"
--- > & someproperty
--- > ! oldproperty
--- > & otherproperty
-host :: HostName -> Host
-host hn = Host hn [] mempty
-
--- | Adds a property to a Host
+-- This can be used with `check` to only run a command when a file
+-- has changed.
--
--- Can add Properties and RevertableProperties
-(&) :: IsProp p => Host -> p -> Host
-(Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfo p)
-
-infixl 1 &
-
--- | Adds a property to the Host in reverted form.
-(!) :: Host -> RevertableProperty -> Host
-h ! p = h & revert p
-
-infixl 1 !
+-- > check ("/etc/aliases" `isNewerThan` "/etc/aliases.db")
+-- > (cmdProperty "newaliases" [] `assume` MadeChange) -- updates aliases.db
+--
+-- Or it can be used with `checkResult` to test if a command made a change.
+--
+-- > checkResult (return ())
+-- > (\_ -> "/etc/aliases.db" `isNewerThan` "/etc/aliases")
+-- > (cmdProperty "newaliases" [])
+--
+-- (If one of the files does not exist, the file that does exist is
+-- considered to be the newer of the two.)
+isNewerThan :: FilePath -> FilePath -> IO Bool
+isNewerThan x y = do
+ mx <- mtime x
+ my <- mtime y
+ return (mx > my)
+ where
+ mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f
--- | Like (&), but adds the property as the first property of the host.
--- Normally, property order should not matter, but this is useful
--- when it does.
-(&^) :: IsProp p => Host -> p -> Host
-(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is)
+-- | Picks one of the two input properties to use,
+-- depending on the targeted OS.
+--
+-- If both input properties support the targeted OS, then the
+-- first will be used.
+--
+-- The resulting property will use the description of the first property
+-- no matter which property is used in the end. So, it's often a good
+-- idea to change the description to something clearer.
+--
+-- For example:
+--
+-- > upgraded :: UnixLike
+-- > upgraded = (Apt.upgraded `pickOS` Pkg.upgraded)
+-- > `describe` "OS upgraded"
+--
+-- If neither input property supports the targeted OS, calls
+-- `unsupportedOS`. Using the example above on a Fedora system would
+-- fail that way.
+pickOS
+ ::
+ ( SingKind ('KProxy :: KProxy ka)
+ , SingKind ('KProxy :: KProxy kb)
+ , DemoteRep ('KProxy :: KProxy ka) ~ [MetaType]
+ , DemoteRep ('KProxy :: KProxy kb) ~ [MetaType]
+ , SingI c
+ -- Would be nice to have this constraint, but
+ -- union will not generate metatypes lists with the same
+ -- order of OS's as is used everywhere else. So,
+ -- would need a type-level sort.
+ --, Union a b ~ c
+ )
+ => Property (MetaTypes (a :: ka))
+ -> Property (MetaTypes (b :: kb))
+ -> Property (MetaTypes c)
+pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
+ where
+ -- This use of getSatisfy is safe, because both a and b
+ -- are added as children, so their info will propigate.
+ c = withOS (getDesc a) $ \_ o ->
+ if matching o a
+ then getSatisfy a
+ else if matching o b
+ then getSatisfy b
+ else unsupportedOS'
+ matching Nothing _ = False
+ matching (Just o) p =
+ Targeting (systemToTargetOS o)
+ `elem`
+ fromSing (proptype p)
+ proptype (Property t _ _ _ _) = t
-infixl 1 &^
+-- | Makes a property that is satisfied differently depending on specifics
+-- of the host's operating system.
+--
+-- > myproperty :: Property Debian
+-- > myproperty = withOS "foo installed" $ \w o -> case o of
+-- > (Just (System (Debian (Stable release)) arch)) -> ensureProperty w ...
+-- > (Just (System (Debian suite) arch)) -> ensureProperty w ...
+-- > _ -> unsupportedOS'
+--
+-- Note that the operating system specifics may not be declared for all hosts,
+-- which is where Nothing comes in.
+withOS
+ :: (SingI metatypes)
+ => Desc
+ -> (OuterMetaTypesWitness '[] -> Maybe System -> Propellor Result)
+ -> Property (MetaTypes metatypes)
+withOS desc a = property desc $ a dummyoutermetatypes =<< getOS
+ where
+ -- Using this dummy value allows ensureProperty to be used
+ -- even though the inner property probably doesn't target everything
+ -- that the outer withOS property targets.
+ dummyoutermetatypes :: OuterMetaTypesWitness ('[])
+ dummyoutermetatypes = OuterMetaTypesWitness sing
--- Changes the action that is performed to satisfy a property.
-adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
-adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
+-- | A property that always fails with an unsupported OS error.
+unsupportedOS :: Property UnixLike
+unsupportedOS = property "unsupportedOS" unsupportedOS'
--- Combines the Info of two properties.
-combineInfo :: (IsProp p, IsProp q) => p -> q -> Info
-combineInfo p q = getInfo p <> getInfo q
+-- | Throws an error, for use in `withOS` when a property is lacking
+-- support for an OS.
+unsupportedOS' :: Propellor Result
+unsupportedOS' = go =<< getOS
+ where
+ go Nothing = error "Unknown host OS is not supported by this property."
+ go (Just o) = error $ "This property is not implemented for " ++ show o
-combineInfos :: IsProp p => [p] -> Info
-combineInfos = mconcat . map getInfo
+-- | Undoes the effect of a RevertableProperty.
+revert :: RevertableProperty setup undo -> RevertableProperty undo setup
+revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
makeChange :: IO () -> Propellor Result
makeChange a = liftIO a >> return MadeChange
noChange :: Propellor Result
noChange = return NoChange
+
+doNothing :: SingI t => Property (MetaTypes t)
+doNothing = property "noop property" noChange
+
+-- | Registers an action that should be run at the very end, after
+-- propellor has checks all the properties of a host.
+endAction :: Desc -> (Result -> Propellor Result) -> Propellor ()
+endAction desc a = tell [EndAction desc a]
diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs
new file mode 100644
index 00000000..1b28759c
--- /dev/null
+++ b/src/Propellor/Property/Aiccu.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Maintainer: Jelmer Vernooij <jelmer@samba.org>
+
+module Propellor.Property.Aiccu (
+ installed,
+ restarted,
+ confPath,
+ UserName,
+ TunnelId,
+ hasConfig,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.File as File
+
+installed :: Property DebianLike
+installed = Apt.installed ["aiccu"]
+
+restarted :: Property DebianLike
+restarted = Service.restarted "aiccu"
+
+confPath :: FilePath
+confPath = "/etc/aiccu.conf"
+
+type TunnelId = String
+
+config :: UserName -> TunnelId -> PrivData -> [File.Line]
+config u t p =
+ [ "protocol tic"
+ , "server tic.sixxs.net"
+ , "username " ++ u
+ , "password " ++ privDataVal p
+ , "ipv6_interface sixxs"
+ , "tunnel_id " ++ t
+ , "daemonize true"
+ , "automatic true"
+ , "requiretls true"
+ , "makebeats true"
+ ]
+
+-- | Configures an ipv6 tunnel using sixxs.net, with the given TunneId
+-- and sixx.net UserName.
+hasConfig :: TunnelId -> UserName -> Property (HasInfo + DebianLike)
+hasConfig t u = prop `onChange` restarted
+ where
+ prop :: Property (HasInfo + UnixLike)
+ prop = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $
+ property' "aiccu configured" . writeConfig
+ writeConfig getpassword w = getpassword $ ensureProperty w . go
+ go (Password u', p) = confPath `File.hasContentProtected` config u' t p
+ go (f, _) = error $ "Unexpected type of privdata: " ++ show f
diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs
index 1d9c35ce..f321143f 100644
--- a/src/Propellor/Property/Apache.hs
+++ b/src/Propellor/Property/Apache.hs
@@ -1,86 +1,109 @@
module Propellor.Property.Apache where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
-import Utility.SafeCommand
+import qualified Propellor.Property.LetsEncrypt as LetsEncrypt
-type ConfigFile = [String]
+installed :: Property DebianLike
+installed = Apt.installed ["apache2"]
-siteEnabled :: HostName -> ConfigFile -> RevertableProperty
-siteEnabled hn cf = RevertableProperty enable disable
- where
- enable = check (not <$> isenabled) $
- cmdProperty "a2ensite" ["--quiet", hn]
- `describe` ("apache site enabled " ++ hn)
- `requires` siteAvailable hn cf
+restarted :: Property DebianLike
+restarted = Service.restarted "apache2"
+
+reloaded :: Property DebianLike
+reloaded = Service.reloaded "apache2"
+
+type ConfigLine = String
+
+type ConfigFile = [ConfigLine]
+
+siteEnabled :: Domain -> ConfigFile -> RevertableProperty DebianLike DebianLike
+siteEnabled domain cf = siteEnabled' domain cf <!> siteDisabled domain
+
+siteEnabled' :: Domain -> ConfigFile -> Property DebianLike
+siteEnabled' domain cf = combineProperties ("apache site enabled " ++ domain) $ props
+ & siteAvailable domain cf
+ `requires` installed
+ `onChange` reloaded
+ & check (not <$> isenabled)
+ (cmdProperty "a2ensite" ["--quiet", domain])
`requires` installed
`onChange` reloaded
- disable = combineProperties
- ("apache site disabled " ++ hn)
- (map File.notPresent (siteCfg hn))
- `onChange` cmdProperty "a2dissite" ["--quiet", hn]
+ where
+ isenabled = boolSystem "a2query" [Param "-q", Param "-s", Param domain]
+
+siteDisabled :: Domain -> Property DebianLike
+siteDisabled domain = combineProperties
+ ("apache site disabled " ++ domain)
+ (toProps $ map File.notPresent (siteCfg domain))
+ `onChange` (cmdProperty "a2dissite" ["--quiet", domain] `assume` MadeChange)
`requires` installed
`onChange` reloaded
- isenabled = boolSystem "a2query" [Param "-q", Param "-s", Param hn]
-siteAvailable :: HostName -> ConfigFile -> Property
-siteAvailable hn cf = combineProperties ("apache site available " ++ hn) $
- map (`File.hasContent` (comment:cf)) (siteCfg hn)
+siteAvailable :: Domain -> ConfigFile -> Property DebianLike
+siteAvailable domain cf = combineProperties ("apache site available " ++ domain) $
+ toProps $ map tightenTargets $
+ map (`File.hasContent` (comment:cf)) (siteCfg domain)
where
comment = "# deployed with propellor, do not modify"
-modEnabled :: String -> RevertableProperty
-modEnabled modname = RevertableProperty enable disable
+modEnabled :: String -> RevertableProperty DebianLike DebianLike
+modEnabled modname = enable <!> disable
where
- enable = check (not <$> isenabled) $
- cmdProperty "a2enmod" ["--quiet", modname]
+ enable = check (not <$> isenabled)
+ (cmdProperty "a2enmod" ["--quiet", modname])
`describe` ("apache module enabled " ++ modname)
`requires` installed
`onChange` reloaded
- disable = check isenabled $
- cmdProperty "a2dismod" ["--quiet", modname]
+ disable = check isenabled
+ (cmdProperty "a2dismod" ["--quiet", modname])
`describe` ("apache module disabled " ++ modname)
`requires` installed
`onChange` reloaded
isenabled = boolSystem "a2query" [Param "-q", Param "-m", Param modname]
+-- | Make apache listen on the specified ports.
+--
+-- Note that ports are also specified inside a site's config file,
+-- so that also needs to be changed.
+listenPorts :: [Port] -> Property DebianLike
+listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps
+ `onChange` restarted
+ where
+ portline port = "Listen " ++ fromPort port
+
-- This is a list of config files because different versions of apache
-- use different filenames. Propellor simply writes them all.
-siteCfg :: HostName -> [FilePath]
-siteCfg hn =
+siteCfg :: Domain -> [FilePath]
+siteCfg domain =
-- Debian pre-2.4
- [ "/etc/apache2/sites-available/" ++ hn
+ [ "/etc/apache2/sites-available/" ++ domain
-- Debian 2.4+
- , "/etc/apache2/sites-available/" ++ hn ++ ".conf"
- ]
-
-installed :: Property
-installed = Apt.installed ["apache2"]
-
-restarted :: Property
-restarted = Service.restarted "apache2"
-
-reloaded :: Property
-reloaded = Service.reloaded "apache2"
+ , "/etc/apache2/sites-available/" ++ domain ++ ".conf"
+ ]
-- | Configure apache to use SNI to differentiate between
-- https hosts.
-multiSSL :: Property
-multiSSL = "/etc/apache2/conf.d/ssl" `File.hasContent`
- [ "NameVirtualHost *:443"
- , "SSLStrictSNIVHostCheck off"
- ]
- `describe` "apache SNI enabled"
- `onChange` reloaded
+--
+-- This was off by default in apache 2.2.22. Newver versions enable
+-- it by default. This property uses the filename used by the old version.
+multiSSL :: Property DebianLike
+multiSSL = check (doesDirectoryExist "/etc/apache2/conf.d") $
+ "/etc/apache2/conf.d/ssl" `File.hasContent`
+ [ "NameVirtualHost *:443"
+ , "SSLStrictSNIVHostCheck off"
+ ]
+ `describe` "apache SNI enabled"
+ `onChange` reloaded
-- | Config file fragment that can be inserted into a <Directory>
-- stanza to allow global read access to the directory.
--
-- Works with multiple versions of apache that have different ways to do
-- it.
-allowAll :: String
+allowAll :: ConfigLine
allowAll = unlines
[ "<IfVersion < 2.4>"
, "Order allow,deny"
@@ -90,3 +113,102 @@ allowAll = unlines
, "Require all granted"
, "</IfVersion>"
]
+
+-- | Config file fragment that can be inserted into a <VirtualHost>
+-- stanza to allow apache to display directory index icons.
+iconDir :: ConfigLine
+iconDir = unlines
+ [ "<Directory \"/usr/share/apache2/icons\">"
+ , "Options Indexes MultiViews"
+ , "AllowOverride None"
+ , allowAll
+ , " </Directory>"
+ ]
+
+type WebRoot = FilePath
+
+-- | A basic virtual host, publishing a directory, and logging to
+-- the combined apache log file. Not https capable.
+virtualHost :: Domain -> Port -> WebRoot -> RevertableProperty DebianLike DebianLike
+virtualHost domain port docroot = virtualHost' domain port docroot []
+
+-- | Like `virtualHost` but with additional config lines added.
+virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty DebianLike DebianLike
+virtualHost' domain port docroot addedcfg = siteEnabled domain $
+ [ "<VirtualHost *:" ++ fromPort port ++ ">"
+ , "ServerName " ++ domain ++ ":" ++ fromPort port
+ , "DocumentRoot " ++ docroot
+ , "ErrorLog /var/log/apache2/error.log"
+ , "LogLevel warn"
+ , "CustomLog /var/log/apache2/access.log combined"
+ , "ServerSignature On"
+ ]
+ ++ addedcfg ++
+ [ "</VirtualHost>"
+ ]
+
+-- | A virtual host using https, with the certificate obtained
+-- using `Propellor.Property.LetsEncrypt.letsEncrypt`.
+--
+-- http connections are redirected to https.
+--
+-- Example:
+--
+-- > httpsVirtualHost "example.com" "/var/www"
+-- > (LetsEncrypt.AgreeTOS (Just "me@my.domain"))
+--
+-- Note that reverting this property does not remove the certificate from
+-- letsencrypt's cert store.
+httpsVirtualHost :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> RevertableProperty DebianLike DebianLike
+httpsVirtualHost domain docroot letos = httpsVirtualHost' domain docroot letos []
+
+-- | Like `httpsVirtualHost` but with additional config lines added.
+httpsVirtualHost' :: Domain -> WebRoot -> LetsEncrypt.AgreeTOS -> [ConfigLine] -> RevertableProperty DebianLike DebianLike
+httpsVirtualHost' domain docroot letos addedcfg = setup <!> teardown
+ where
+ setup = setuphttp
+ `requires` modEnabled "rewrite"
+ `requires` modEnabled "ssl"
+ `before` setuphttps
+ teardown = siteDisabled domain
+ setuphttp = siteEnabled' domain $
+ -- The sslconffile is only created after letsencrypt gets
+ -- the cert. The "*" is needed to make apache not error
+ -- when the file doesn't exist.
+ ("IncludeOptional " ++ sslconffile "*")
+ : vhost (Port 80)
+ [ "RewriteEngine On"
+ -- Pass through .well-known directory on http for the
+ -- letsencrypt acme challenge.
+ , "RewriteRule ^/.well-known/(.*) - [L]"
+ -- Everything else redirects to https
+ , "RewriteRule ^/(.*) https://" ++ domain ++ "/$1 [L,R,NE]"
+ ]
+ setuphttps = LetsEncrypt.letsEncrypt letos domain docroot
+ `onChange` postsetuphttps
+ postsetuphttps = combineProperties (domain ++ " ssl cert installed") $ props
+ & File.dirExists (takeDirectory cf)
+ & File.hasContent cf sslvhost
+ `onChange` reloaded
+ -- always reload since the cert has changed
+ & reloaded
+ where
+ cf = sslconffile "letsencrypt"
+ sslvhost = vhost (Port 443)
+ [ "SSLEngine on"
+ , "SSLCertificateFile " ++ LetsEncrypt.certFile domain
+ , "SSLCertificateKeyFile " ++ LetsEncrypt.privKeyFile domain
+ , "SSLCertificateChainFile " ++ LetsEncrypt.chainFile domain
+ ]
+ sslconffile s = "/etc/apache2/sites-available/ssl/" ++ domain ++ "/" ++ s ++ ".conf"
+ vhost p ls =
+ [ "<VirtualHost *:" ++ fromPort p ++">"
+ , "ServerName " ++ domain ++ ":" ++ fromPort p
+ , "DocumentRoot " ++ docroot
+ , "ErrorLog /var/log/apache2/error.log"
+ , "LogLevel warn"
+ , "CustomLog /var/log/apache2/access.log combined"
+ , "ServerSignature On"
+ ] ++ ls ++ addedcfg ++
+ [ "</VirtualHost>"
+ ]
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 7cf6c2b0..5e185a0e 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -1,12 +1,15 @@
+{-# LANGUAGE FlexibleContexts #-}
+
module Propellor.Property.Apt where
import Data.Maybe
-import Control.Applicative
import Data.List
import System.IO
import Control.Monad
+import Control.Applicative
+import Prelude
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Service as Service
import Propellor.Property.File (Line)
@@ -29,6 +32,10 @@ backportSuite :: DebianSuite -> Maybe String
backportSuite (Stable s) = Just (s ++ "-backports")
backportSuite _ = Nothing
+stableUpdatesSuite :: DebianSuite -> Maybe String
+stableUpdatesSuite (Stable s) = Just (s ++ "-updates")
+stableUpdatesSuite _ = Nothing
+
debLine :: String -> Url -> [Section] -> Line
debLine suite mirror sections = unwords $
["deb", mirror, suite] ++ sections
@@ -55,7 +62,7 @@ binandsrc url suite = catMaybes
return $ debLine bs url stdSections
debCdn :: SourcesGenerator
-debCdn = binandsrc "http://http.debian.net/debian"
+debCdn = binandsrc "http://httpredir.debian.org/debian"
kernelOrg :: SourcesGenerator
kernelOrg = binandsrc "http://mirrors.kernel.org/debian"
@@ -68,42 +75,41 @@ securityUpdates suite
in [l, srcLine l]
| otherwise = []
--- | Makes sources.list have a standard content using the mirror CDN,
+-- | Makes sources.list have a standard content using the Debian mirror CDN,
-- with the Debian suite configured by the os.
--
-- Since the CDN is sometimes unreliable, also adds backup lines using
-- kernel.org.
-stdSourcesList :: Property
-stdSourcesList = withOS ("standard sources.list") $ \o ->
- case o of
- (Just (System (Debian suite) _)) ->
- ensureProperty $ stdSourcesListFor suite
- _ -> error "os is not declared to be Debian"
-
-stdSourcesListFor :: DebianSuite -> Property
+stdSourcesList :: Property Debian
+stdSourcesList = withOS "standard sources.list" $ \w o -> case o of
+ (Just (System (Debian suite) _)) ->
+ ensureProperty w $ stdSourcesListFor suite
+ _ -> unsupportedOS'
+
+stdSourcesListFor :: DebianSuite -> Property Debian
stdSourcesListFor suite = stdSourcesList' suite []
-- | Adds additional sources.list generators.
--
-- Note that if a Property needs to enable an apt source, it's better
--- to do so via a separate file in /etc/apt/sources.list.d/
-stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property
-stdSourcesList' suite more = setSourcesList
+-- to do so via a separate file in </etc/apt/sources.list.d/>
+stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian
+stdSourcesList' suite more = tightenTargets $ setSourcesList
(concatMap (\gen -> gen suite) generators)
`describe` ("standard sources.list for " ++ show suite)
where
generators = [debCdn, kernelOrg, securityUpdates] ++ more
-setSourcesList :: [Line] -> Property
+setSourcesList :: [Line] -> Property DebianLike
setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
-setSourcesListD :: [Line] -> FilePath -> Property
+setSourcesListD :: [Line] -> FilePath -> Property DebianLike
setSourcesListD ls basename = f `File.hasContent` ls `onChange` update
where
f = "/etc/apt/sources.list.d/" ++ basename ++ ".list"
-runApt :: [String] -> Property
-runApt ps = cmdProperty' "apt-get" ps noninteractiveEnv
+runApt :: [String] -> UncheckedProperty DebianLike
+runApt ps = tightenTargets $ cmdPropertyEnv "apt-get" ps noninteractiveEnv
noninteractiveEnv :: [(String, String)]
noninteractiveEnv =
@@ -111,75 +117,93 @@ noninteractiveEnv =
, ("APT_LISTCHANGES_FRONTEND", "none")
]
-update :: Property
-update = runApt ["update"]
- `describe` "apt update"
-
-upgrade :: Property
-upgrade = runApt ["-y", "dist-upgrade"]
- `describe` "apt dist-upgrade"
+-- | Have apt update its lists of packages, but without upgrading anything.
+update :: Property DebianLike
+update = combineProperties ("apt update") $ props
+ & pendingConfigured
+ & runApt ["update"]
+ `assume` MadeChange
+
+-- | Have apt upgrade packages, adding new packages and removing old as
+-- necessary. Often used in combination with the `update` property.
+upgrade :: Property DebianLike
+upgrade = upgrade' "dist-upgrade"
+
+upgrade' :: String -> Property DebianLike
+upgrade' p = combineProperties ("apt " ++ p) $ props
+ & pendingConfigured
+ & runApt ["-y", p]
+ `assume` MadeChange
+
+-- | Have apt upgrade packages, but never add new packages or remove
+-- old packages. Not suitable for upgrading acrocess major versions
+-- of the distribution.
+safeUpgrade :: Property DebianLike
+safeUpgrade = upgrade' "upgrade"
+
+-- | Have dpkg try to configure any packages that are not fully configured.
+pendingConfigured :: Property DebianLike
+pendingConfigured = tightenTargets $
+ cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv
+ `assume` MadeChange
+ `describe` "dpkg configured pending"
type Package = String
-installed :: [Package] -> Property
+installed :: [Package] -> Property DebianLike
installed = installed' ["-y"]
-installed' :: [String] -> [Package] -> Property
+installed' :: [String] -> [Package] -> Property DebianLike
installed' params ps = robustly $ check (isInstallable ps) go
- `describe` (unwords $ "apt installed":ps)
+ `describe` unwords ("apt installed":ps)
where
- go = runApt $ params ++ ["install"] ++ ps
+ go = runApt (params ++ ["install"] ++ ps)
-installedBackport :: [Package] -> Property
-installedBackport ps = trivial $ withOS desc $ \o -> case o of
- Nothing -> error "cannot install backports; os not declared"
+installedBackport :: [Package] -> Property Debian
+installedBackport ps = withOS desc $ \w o -> case o of
(Just (System (Debian suite) _)) -> case backportSuite suite of
- Nothing -> notsupported o
- Just bs -> ensureProperty $ runApt $
- ["install", "-t", bs, "-y"] ++ ps
- _ -> notsupported o
+ Nothing -> unsupportedOS'
+ Just bs -> ensureProperty w $
+ runApt (["install", "-t", bs, "-y"] ++ ps)
+ `changesFile` dpkgStatus
+ _ -> unsupportedOS'
where
- desc = (unwords $ "apt installed backport":ps)
- notsupported o = error $ "backports not supported on " ++ show o
+ desc = unwords ("apt installed backport":ps)
-- | Minimal install of package, without recommends.
-installedMin :: [Package] -> Property
+installedMin :: [Package] -> Property DebianLike
installedMin = installed' ["--no-install-recommends", "-y"]
-removed :: [Package] -> Property
-removed ps = check (or <$> isInstalled' ps) go
- `describe` (unwords $ "apt removed":ps)
- where
- go = runApt $ ["-y", "remove"] ++ ps
+removed :: [Package] -> Property DebianLike
+removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps))
+ `describe` unwords ("apt removed":ps)
-buildDep :: [Package] -> Property
-buildDep ps = robustly go
- `describe` (unwords $ "apt build-dep":ps)
+buildDep :: [Package] -> Property DebianLike
+buildDep ps = robustly $ go
+ `changesFile` dpkgStatus
+ `describe` unwords ("apt build-dep":ps)
where
go = runApt $ ["-y", "build-dep"] ++ ps
-- | Installs the build deps for the source package unpacked
-- in the specifed directory, with a dummy package also
-- installed so that autoRemove won't remove them.
-buildDepIn :: FilePath -> Property
-buildDepIn dir = go `requires` installedMin ["devscripts", "equivs"]
+buildDepIn :: FilePath -> Property DebianLike
+buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
+ `changesFile` dpkgStatus
+ `requires` installedMin ["devscripts", "equivs"]
where
- go = cmdProperty' "sh" ["-c", "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove"]
- noninteractiveEnv
+ cmd = "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove"
-- | Package installation may fail becuse the archive has changed.
-- Run an update in that case and retry.
-robustly :: Property -> Property
-robustly p = adjustProperty p $ \satisfy -> do
- r <- satisfy
- if r == FailedChange
- then ensureProperty $ p `requires` update
- else return r
+robustly :: Property DebianLike -> Property DebianLike
+robustly p = p `fallback` (update `before` p)
isInstallable :: [Package] -> IO Bool
isInstallable ps = do
l <- isInstalled' ps
- return $ any (== False) l && not (null l)
+ return $ elem False l && not (null l)
isInstalled :: Package -> IO Bool
isInstalled p = (== [True]) <$> isInstalled' [p]
@@ -189,25 +213,30 @@ isInstalled p = (== [True]) <$> isInstalled' [p]
-- even vary. If apt does not know about a package at all, it will not
-- be included in the result list.
isInstalled' :: [Package] -> IO [Bool]
-isInstalled' ps = catMaybes . map parse . lines
- <$> readProcess "apt-cache" ("policy":ps)
+isInstalled' ps = (mapMaybe parse . lines) <$> policy
where
parse l
| "Installed: (none)" `isInfixOf` l = Just False
| "Installed: " `isInfixOf` l = Just True
| otherwise = Nothing
+ policy = do
+ environ <- addEntry "LANG" "C" <$> getEnvironment
+ readProcessEnv "apt-cache" ("policy":ps) (Just environ)
-autoRemove :: Property
+autoRemove :: Property DebianLike
autoRemove = runApt ["-y", "autoremove"]
+ `changesFile` dpkgStatus
`describe` "apt autoremove"
-- | Enables unattended upgrades. Revert to disable.
-unattendedUpgrades :: RevertableProperty
-unattendedUpgrades = RevertableProperty enable disable
+unattendedUpgrades :: RevertableProperty DebianLike DebianLike
+unattendedUpgrades = enable <!> disable
where
enable = setup True
`before` Service.running "cron"
`before` configure
+ -- work around http://bugs.debian.org/812380
+ `before` File.notPresent "/etc/apt/apt.conf.d/50unattended-upgrades.ucf-dist"
disable = setup False
setup enabled = (if enabled then installed else removed) ["unattended-upgrades"]
@@ -218,36 +247,64 @@ unattendedUpgrades = RevertableProperty enable disable
v
| enabled = "true"
| otherwise = "false"
-
- configure = withOS "unattended upgrades configured" $ \o ->
- case o of
- -- the package defaults to only upgrading stable
- (Just (System (Debian suite) _))
- | not (isStable suite) -> ensureProperty $
- "/etc/apt/apt.conf.d/50unattended-upgrades"
- `File.containsLine`
- ("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
- _ -> noChange
+
+ configure :: Property DebianLike
+ configure = propertyList "unattended upgrades configured" $ props
+ & enableupgrading
+ & unattendedconfig `File.containsLine` "Unattended-Upgrade::Mail \"root\";"
+ where
+ enableupgrading :: Property DebianLike
+ enableupgrading = withOS "unattended upgrades configured" $ \w o ->
+ case o of
+ -- the package defaults to only upgrading stable
+ (Just (System (Debian suite) _))
+ | not (isStable suite) -> ensureProperty w $
+ unattendedconfig
+ `File.containsLine`
+ ("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
+ _ -> noChange
+ unattendedconfig = "/etc/apt/apt.conf.d/50unattended-upgrades"
+
+-- | Enable periodic updates (but not upgrades), including download
+-- of packages.
+periodicUpdates :: Property DebianLike
+periodicUpdates = tightenTargets $ "/etc/apt/apt.conf.d/02periodic" `File.hasContent`
+ [ "APT::Periodic::Enable \"1\";"
+ , "APT::Periodic::Update-Package-Lists \"1\";"
+ , "APT::Periodic::Download-Upgradeable-Packages \"1\";"
+ , "APT::Periodic::Verbose \"1\";"
+ ]
+
+type DebconfTemplate = String
+type DebconfTemplateType = String
+type DebconfTemplateValue = String
-- | Preseeds debconf values and reconfigures the package so it takes
-- effect.
-reConfigure :: Package -> [(String, String, String)] -> Property
-reConfigure package vals = reconfigure `requires` setselections
- `describe` ("reconfigure " ++ package)
+reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike
+reConfigure package vals = tightenTargets $
+ reconfigure
+ `requires` setselections
+ `describe` ("reconfigure " ++ package)
where
- setselections = property "preseed" $ makeChange $
- withHandle StdinHandle createProcessSuccess
- (proc "debconf-set-selections" []) $ \h -> do
- forM_ vals $ \(tmpl, tmpltype, value) ->
- hPutStrLn h $ unwords [package, tmpl, tmpltype, value]
- hClose h
- reconfigure = cmdProperty' "dpkg-reconfigure" ["-fnone", package] noninteractiveEnv
+ setselections :: Property DebianLike
+ setselections = property "preseed" $
+ if null vals
+ then noChange
+ else makeChange $
+ withHandle StdinHandle createProcessSuccess
+ (proc "debconf-set-selections" []) $ \h -> do
+ forM_ vals $ \(tmpl, tmpltype, value) ->
+ hPutStrLn h $ unwords [package, tmpl, tmpltype, value]
+ hClose h
+ reconfigure = cmdPropertyEnv "dpkg-reconfigure" ["-fnone", package] noninteractiveEnv
+ `assume` MadeChange
-- | Ensures that a service is installed and running.
--
-- Assumes that there is a 1:1 mapping between service names and apt
-- package names.
-serviceInstalledRunning :: Package -> Property
+serviceInstalledRunning :: Package -> Property DebianLike
serviceInstalledRunning svc = Service.running svc `requires` installed [svc]
data AptKey = AptKey
@@ -255,21 +312,41 @@ data AptKey = AptKey
, pubkey :: String
}
-trustsKey :: AptKey -> RevertableProperty
-trustsKey k = RevertableProperty trust untrust
+trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike
+trustsKey k = trustsKey' k <!> untrustKey k
+
+trustsKey' :: AptKey -> Property DebianLike
+trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
+ withHandle StdinHandle createProcessSuccess
+ (proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
+ hPutStr h (pubkey k)
+ hClose h
+ nukeFile $ f ++ "~" -- gpg dropping
where
desc = "apt trusts key " ++ keyname k
- f = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
- untrust = File.notPresent f
- trust = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
- withHandle StdinHandle createProcessSuccess
- (proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
- hPutStr h (pubkey k)
- hClose h
- nukeFile $ f ++ "~" -- gpg dropping
+ f = aptKeyFile k
+
+untrustKey :: AptKey -> Property DebianLike
+untrustKey = tightenTargets . File.notPresent . aptKeyFile
+
+aptKeyFile :: AptKey -> FilePath
+aptKeyFile k = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
-- | Cleans apt's cache of downloaded packages to avoid using up disk
-- space.
-cacheCleaned :: Property
-cacheCleaned = trivial $ cmdProperty "apt-get" ["clean"]
- `describe` "apt cache cleaned"
+cacheCleaned :: Property DebianLike
+cacheCleaned = tightenTargets $ cmdProperty "apt-get" ["clean"]
+ `assume` NoChange
+ `describe` "apt cache cleaned"
+
+-- | Add a foreign architecture to dpkg and apt.
+hasForeignArch :: String -> Property DebianLike
+hasForeignArch arch = check notAdded (add `before` update)
+ `describe` ("dpkg has foreign architecture " ++ arch)
+ where
+ notAdded = (notElem arch . lines) <$> readProcess "dpkg" ["--print-foreign-architectures"]
+ add = cmdProperty "dpkg" ["--add-architecture", arch]
+ `assume` MadeChange
+
+dpkgStatus :: FilePath
+dpkgStatus = "/var/lib/dpkg/status"
diff --git a/src/Propellor/Property/Apt/PPA.hs b/src/Propellor/Property/Apt/PPA.hs
new file mode 100644
index 00000000..49fa9fa7
--- /dev/null
+++ b/src/Propellor/Property/Apt/PPA.hs
@@ -0,0 +1,115 @@
+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
+--
+-- Personal Package Archives
+module Propellor.Property.Apt.PPA where
+
+import Data.List
+import Control.Applicative
+import Prelude
+import Data.String.Utils
+import Data.String (IsString(..))
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+
+-- | Ensure software-properties-common is installed.
+installed :: Property DebianLike
+installed = Apt.installed ["software-properties-common"]
+
+-- | Personal Package Archives are people's individual package
+-- contributions to the Buntish distro. There's a well-known format for
+-- representing them, and this type represents that. It's also an instance
+-- of 'Show' and 'IsString' so it can work with 'OverloadedStrings'.
+-- More on PPAs can be found at <https://help.launchpad.net/Packaging/PPA>
+data PPA = PPA
+ { ppaAccount :: String -- ^ The Launchpad account hosting this archive.
+ , ppaArchive :: String -- ^ The name of the archive.
+ } deriving (Eq, Ord)
+
+instance Show PPA where
+ show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]
+
+instance IsString PPA where
+ -- | Parse strings like "ppa:zfs-native/stable" into a PPA.
+ fromString s =
+ let
+ [_, ppa] = split "ppa:" s
+ [acct, arch] = split "/" ppa
+ in
+ PPA acct arch
+
+-- | Adds a PPA to the local system repositories.
+addPpa :: PPA -> Property DebianLike
+addPpa p =
+ cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv
+ `assume` MadeChange
+ `describe` ("Added PPA " ++ (show p))
+ `requires` installed
+
+-- | A repository key ID to be downloaded with apt-key.
+data AptKeyId = AptKeyId
+ { akiName :: String
+ , akiId :: String
+ , akiServer :: String
+ } deriving (Eq, Ord)
+
+instance Show AptKeyId where
+ show k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]
+
+-- | Adds an 'AptKeyId' from the specified GPG server.
+addKeyId :: AptKeyId -> Property DebianLike
+addKeyId keyId =
+ check keyTrusted akcmd
+ `describe` (unwords ["Add third-party Apt key", show keyId])
+ where
+ akcmd =
+ tightenTargets $ cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId]
+ keyTrusted =
+ let
+ pks ls = concatMap (drop 1 . split "/")
+ $ concatMap (take 1 . drop 1 . words)
+ $ filter (\l -> "pub" `isPrefixOf` l)
+ $ lines ls
+ nkid = take 8 (akiId keyId)
+ in
+ (isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"]
+
+-- | An Apt source line that apt-add-repository will just add to
+-- sources.list. It's also an instance of both 'Show' and 'IsString' to make
+-- using 'OverloadedStrings' in the configuration file easier.
+--
+-- | FIXME there's apparently an optional "options" fragment that I've
+-- definitely not parsed here.
+data AptSource = AptSource
+ { asURL :: Apt.Url -- ^ The URL hosting the repository
+ , asSuite :: String -- ^ The operating system suite
+ , asComponents :: [String] -- ^ The list of components to install from this repository.
+ } deriving (Eq, Ord)
+
+instance Show AptSource where
+ show asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]
+
+instance IsString AptSource where
+ fromString s =
+ let
+ url:suite:comps = drop 1 . words $ s
+ in
+ AptSource url suite comps
+
+-- | A repository for apt-add-source, either a PPA or a regular repository line.
+data AptRepository = AptRepositoryPPA PPA | AptRepositorySource AptSource
+
+-- | Adds an 'AptRepository' using apt-add-source.
+addRepository :: AptRepository -> Property DebianLike
+addRepository (AptRepositoryPPA p) = addPpa p
+addRepository (AptRepositorySource src) =
+ check repoExists addSrc
+ `describe` unwords ["Adding APT repository", show src]
+ `requires` installed
+ where
+ allSourceLines =
+ readProcess "/bin/sh" ["-c", "cat /etc/apt/sources.list /etc/apt/sources.list.d/*"]
+ activeSources = map (\s -> fromString s :: AptSource )
+ . filter (not . isPrefixOf "#")
+ . filter (/= "") . lines <$> allSourceLines
+ repoExists = isInfixOf [src] <$> activeSources
+ addSrc = cmdProperty "apt-add-source" [show src]
diff --git a/src/Propellor/Property/Attic.hs b/src/Propellor/Property/Attic.hs
new file mode 100644
index 00000000..4415f8c0
--- /dev/null
+++ b/src/Propellor/Property/Attic.hs
@@ -0,0 +1,149 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+--
+-- Support for the Attic backup tool <https://attic-backup.org/>
+
+module Propellor.Property.Attic
+ ( installed
+ , repoExists
+ , init
+ , restored
+ , backup
+ , KeepPolicy (..)
+ ) where
+
+import Propellor.Base hiding (init)
+import Prelude hiding (init)
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Cron as Cron
+import Data.List (intercalate)
+
+type AtticParam = String
+
+type AtticRepo = FilePath
+
+installed :: Property DebianLike
+installed = Apt.installed ["attic"]
+
+repoExists :: AtticRepo -> IO Bool
+repoExists repo = boolSystem "attic" [Param "list", File repo]
+
+-- | Inits a new attic repository
+init :: AtticRepo -> Property DebianLike
+init backupdir = check (not <$> repoExists backupdir) (cmdProperty "attic" initargs)
+ `requires` installed
+ where
+ initargs =
+ [ "init"
+ , backupdir
+ ]
+
+-- | Restores a directory from an attic backup.
+--
+-- Only does anything if the directory does not exist, or exists,
+-- but is completely empty.
+--
+-- The restore is performed atomically; restoring to a temp directory
+-- and then moving it to the directory.
+restored :: FilePath -> AtticRepo -> Property DebianLike
+restored dir backupdir = go `requires` installed
+ where
+ go :: Property DebianLike
+ go = property (dir ++ " restored by attic") $ ifM (liftIO needsRestore)
+ ( do
+ warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
+ liftIO restore
+ , noChange
+ )
+
+ needsRestore = null <$> catchDefaultIO [] (dirContents dir)
+
+ restore = withTmpDirIn (takeDirectory dir) "attic-restore" $ \tmpdir -> do
+ ok <- boolSystem "attic" $
+ [ Param "extract"
+ , Param backupdir
+ , Param tmpdir
+ ]
+ let restoreddir = tmpdir ++ "/" ++ dir
+ ifM (pure ok <&&> doesDirectoryExist restoreddir)
+ ( do
+ void $ tryIO $ removeDirectory dir
+ renameDirectory restoreddir dir
+ return MadeChange
+ , return FailedChange
+ )
+
+-- | Installs a cron job that causes a given directory to be backed
+-- up, by running attic with some parameters.
+--
+-- If the directory does not exist, or exists but is completely empty,
+-- this Property will immediately restore it from an existing backup.
+--
+-- So, this property can be used to deploy a directory of content
+-- to a host, while also ensuring any changes made to it get backed up.
+-- For example:
+--
+-- > & Attic.backup "/srv/git" "root@myserver:/mnt/backup/git.attic" Cron.Daily
+-- > ["--exclude=/srv/git/tobeignored"]
+-- > [Attic.KeepDays 7, Attic.KeepWeeks 4, Attic.KeepMonths 6, Attic.KeepYears 1]
+--
+-- Note that this property does not make attic encrypt the backup
+-- repository.
+--
+-- Since attic uses a fair amount of system resources, only one attic
+-- backup job will be run at a time. Other jobs will wait their turns to
+-- run.
+backup :: FilePath -> AtticRepo -> Cron.Times -> [AtticParam] -> [KeepPolicy] -> Property DebianLike
+backup dir backupdir crontimes extraargs kp = backup' dir backupdir crontimes extraargs kp
+ `requires` restored dir backupdir
+
+-- | Does a backup, but does not automatically restore.
+backup' :: FilePath -> AtticRepo -> Cron.Times -> [AtticParam] -> [KeepPolicy] -> Property DebianLike
+backup' dir backupdir crontimes extraargs kp = cronjob
+ `describe` desc
+ `requires` installed
+ where
+ desc = backupdir ++ " attic backup"
+ cronjob = Cron.niceJob ("attic_backup" ++ dir) crontimes (User "root") "/" $
+ "flock " ++ shellEscape lockfile ++ " sh -c " ++ backupcmd
+ lockfile = "/var/lock/propellor-attic.lock"
+ backupcmd = intercalate ";" $
+ createCommand
+ : if null kp then [] else [pruneCommand]
+ createCommand = unwords $
+ [ "attic"
+ , "create"
+ , "--stats"
+ ]
+ ++ map shellEscape extraargs ++
+ [ shellEscape backupdir ++ "::" ++ "$(date --iso-8601=ns --utc)"
+ , shellEscape dir
+ ]
+ pruneCommand = unwords $
+ [ "attic"
+ , "prune"
+ , shellEscape backupdir
+ ]
+ ++
+ map keepParam kp
+
+-- | Constructs an AtticParam that specifies which old backup generations to
+-- keep. By default, all generations are kept. However, when this parameter is
+-- passed to the `backup` property, they will run attic prune to clean out
+-- generations not specified here.
+keepParam :: KeepPolicy -> AtticParam
+keepParam (KeepHours n) = "--keep-hourly=" ++ show n
+keepParam (KeepDays n) = "--keep-daily=" ++ show n
+keepParam (KeepWeeks n) = "--keep-daily=" ++ show n
+keepParam (KeepMonths n) = "--keep-monthly=" ++ show n
+keepParam (KeepYears n) = "--keep-yearly=" ++ show n
+
+-- | Policy for backup generations to keep. For example, KeepDays 30 will
+-- keep the latest backup for each day when a backup was made, and keep the
+-- last 30 such backups. When multiple KeepPolicies are combined together,
+-- backups meeting any policy are kept. See attic's man page for details.
+data KeepPolicy
+ = KeepHours Int
+ | KeepDays Int
+ | KeepWeeks Int
+ | KeepMonths Int
+ | KeepYears Int
diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs
new file mode 100644
index 00000000..f5842115
--- /dev/null
+++ b/src/Propellor/Property/Borg.hs
@@ -0,0 +1,155 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+--
+-- Support for the Borg backup tool <https://github.com/borgbackup>
+
+module Propellor.Property.Borg
+ ( installed
+ , repoExists
+ , init
+ , restored
+ , backup
+ , KeepPolicy (..)
+ ) where
+
+import Propellor.Base hiding (init)
+import Prelude hiding (init)
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Cron as Cron
+import Data.List (intercalate)
+
+type BorgParam = String
+
+type BorgRepo = FilePath
+
+installed :: Property DebianLike
+installed = withOS desc $ \w o -> case o of
+ (Just (System (Debian (Stable "jessie")) _)) -> ensureProperty w $
+ Apt.installedBackport ["borgbackup"]
+ _ -> ensureProperty w $
+ Apt.installed ["borgbackup"]
+ where
+ desc = "installed borgbackup"
+
+repoExists :: BorgRepo -> IO Bool
+repoExists repo = boolSystem "borg" [Param "list", File repo]
+
+-- | Inits a new borg repository
+init :: BorgRepo -> Property DebianLike
+init backupdir = check (not <$> repoExists backupdir) (cmdProperty "borg" initargs)
+ `requires` installed
+ where
+ initargs =
+ [ "init"
+ , backupdir
+ ]
+
+-- | Restores a directory from an borg backup.
+--
+-- Only does anything if the directory does not exist, or exists,
+-- but is completely empty.
+--
+-- The restore is performed atomically; restoring to a temp directory
+-- and then moving it to the directory.
+restored :: FilePath -> BorgRepo -> Property DebianLike
+restored dir backupdir = go `requires` installed
+ where
+ go :: Property DebianLike
+ go = property (dir ++ " restored by borg") $ ifM (liftIO needsRestore)
+ ( do
+ warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
+ liftIO restore
+ , noChange
+ )
+
+ needsRestore = null <$> catchDefaultIO [] (dirContents dir)
+
+ restore = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do
+ ok <- boolSystem "borg" $
+ [ Param "extract"
+ , Param backupdir
+ , Param tmpdir
+ ]
+ let restoreddir = tmpdir ++ "/" ++ dir
+ ifM (pure ok <&&> doesDirectoryExist restoreddir)
+ ( do
+ void $ tryIO $ removeDirectory dir
+ renameDirectory restoreddir dir
+ return MadeChange
+ , return FailedChange
+ )
+
+-- | Installs a cron job that causes a given directory to be backed
+-- up, by running borg with some parameters.
+--
+-- If the directory does not exist, or exists but is completely empty,
+-- this Property will immediately restore it from an existing backup.
+--
+-- So, this property can be used to deploy a directory of content
+-- to a host, while also ensuring any changes made to it get backed up.
+-- For example:
+--
+-- > & Borg.backup "/srv/git" "root@myserver:/mnt/backup/git.borg" Cron.Daily
+-- > ["--exclude=/srv/git/tobeignored"]
+-- > [Borg.KeepDays 7, Borg.KeepWeeks 4, Borg.KeepMonths 6, Borg.KeepYears 1]
+--
+-- Note that this property does not make borg encrypt the backup
+-- repository.
+--
+-- Since borg uses a fair amount of system resources, only one borg
+-- backup job will be run at a time. Other jobs will wait their turns to
+-- run.
+backup :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike
+backup dir backupdir crontimes extraargs kp = backup' dir backupdir crontimes extraargs kp
+ `requires` restored dir backupdir
+
+-- | Does a backup, but does not automatically restore.
+backup' :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike
+backup' dir backupdir crontimes extraargs kp = cronjob
+ `describe` desc
+ `requires` installed
+ where
+ desc = backupdir ++ " borg backup"
+ cronjob = Cron.niceJob ("borg_backup" ++ dir) crontimes (User "root") "/" $
+ "flock " ++ shellEscape lockfile ++ " sh -c " ++ backupcmd
+ lockfile = "/var/lock/propellor-borg.lock"
+ backupcmd = intercalate ";" $
+ createCommand
+ : if null kp then [] else [pruneCommand]
+ createCommand = unwords $
+ [ "borg"
+ , "create"
+ , "--stats"
+ ]
+ ++ map shellEscape extraargs ++
+ [ shellEscape backupdir ++ "::" ++ "$(date --iso-8601=ns --utc)"
+ , shellEscape dir
+ ]
+ pruneCommand = unwords $
+ [ "borg"
+ , "prune"
+ , shellEscape backupdir
+ ]
+ ++
+ map keepParam kp
+
+-- | Constructs an BorgParam that specifies which old backup generations to
+-- keep. By default, all generations are kept. However, when this parameter is
+-- passed to the `backup` property, they will run borg prune to clean out
+-- generations not specified here.
+keepParam :: KeepPolicy -> BorgParam
+keepParam (KeepHours n) = "--keep-hourly=" ++ show n
+keepParam (KeepDays n) = "--keep-daily=" ++ show n
+keepParam (KeepWeeks n) = "--keep-daily=" ++ show n
+keepParam (KeepMonths n) = "--keep-monthly=" ++ show n
+keepParam (KeepYears n) = "--keep-yearly=" ++ show n
+
+-- | Policy for backup generations to keep. For example, KeepDays 30 will
+-- keep the latest backup for each day when a backup was made, and keep the
+-- last 30 such backups. When multiple KeepPolicies are combined together,
+-- backups meeting any policy are kept. See borg's man page for details.
+data KeepPolicy
+ = KeepHours Int
+ | KeepDays Int
+ | KeepWeeks Int
+ | KeepMonths Int
+ | KeepYears Int
diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs
new file mode 100644
index 00000000..f2246fe1
--- /dev/null
+++ b/src/Propellor/Property/Ccache.hs
@@ -0,0 +1,110 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+module Propellor.Property.Ccache (
+ hasCache,
+ hasLimits,
+ Limit(..),
+ DataSize,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+import Utility.FileMode
+import Utility.DataUnits
+import System.Posix.Files
+
+-- | Limits on the size of a ccache
+data Limit
+ -- | The maximum size of the cache, as a string such as "4G"
+ = MaxSize DataSize
+ -- | The maximum number of files in the cache
+ | MaxFiles Integer
+ -- | A cache with no limit specified
+ | NoLimit
+ | Limit :+ Limit
+
+instance Monoid Limit where
+ mempty = NoLimit
+ mappend = (:+)
+
+-- | A string that will be parsed to get a data size.
+--
+-- Examples: "100 megabytes" or "0.5tb"
+type DataSize = String
+
+maxSizeParam :: DataSize -> Maybe String
+maxSizeParam s = readSize dataUnits s
+ >>= \sz -> Just $ "--max-size=" ++ ccacheSizeUnits sz
+
+-- Generates size units as used in ccache.conf. The smallest unit we can
+-- specify in a ccache config files is a kilobyte
+ccacheSizeUnits :: Integer -> String
+ccacheSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz)
+ where
+ cfgfileunits :: [Unit]
+ cfgfileunits =
+ [ Unit (p 4) "Ti" "terabyte"
+ , Unit (p 3) "Gi" "gigabyte"
+ , Unit (p 2) "Mi" "megabyte"
+ , Unit (p 1) "Ki" "kilobyte"
+ ]
+ p :: Integer -> Integer
+ p n = 1024^n
+
+-- | Set limits on a given ccache
+hasLimits :: FilePath -> Limit -> Property DebianLike
+path `hasLimits` limit = go `requires` installed
+ where
+ go
+ | null params' = doNothing
+ -- We invoke ccache itself to set the limits, so that it can
+ -- handle replacing old limits in the config file, duplicates
+ -- etc.
+ | null errors =
+ cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)]
+ `changesFileContent` (path </> "ccache.conf")
+ | otherwise = property "couldn't parse ccache limits" $
+ sequence_ (errorMessage <$> errors)
+ >> return FailedChange
+
+ params = limitToParams limit
+ (errors, params') = partitionEithers params
+
+limitToParams :: Limit -> [Either String String]
+limitToParams NoLimit = []
+limitToParams (MaxSize s) = case maxSizeParam s of
+ Just param -> [Right param]
+ Nothing -> [Left $ "unable to parse data size " ++ s]
+limitToParams (MaxFiles f) = [Right $ "--max-files=" ++ show f]
+limitToParams (l1 :+ l2) = limitToParams l1 <> limitToParams l2
+
+-- | Configures a ccache in /var/cache for a group
+--
+-- If you say
+--
+-- > & (Group "foo") `Ccache.hasGroupCache`
+-- > (Ccache.MaxSize "4G" <> Ccache.MaxFiles 10000)
+--
+-- you instruct propellor to create a ccache in /var/cache/ccache-foo owned and
+-- writeable by the foo group, with a maximum cache size of 4GB or 10000 files.
+hasCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike
+group@(Group g) `hasCache` limit = (make `requires` installed) <!> delete
+ where
+ make = propertyList ("ccache for " ++ g ++ " group exists") $ props
+ & File.dirExists path
+ & File.ownerGroup path (User "root") group
+ & File.mode path (combineModes $
+ readModes ++ executeModes
+ ++ [ownerWriteMode, groupWriteMode])
+ & hasLimits path limit
+
+ delete = check (doesDirectoryExist path) $
+ cmdProperty "rm" ["-r", path] `assume` MadeChange
+ `describe` ("ccache for " ++ g ++ " does not exist")
+
+ path = "/var/cache/ccache-" ++ g
+
+installed :: Property DebianLike
+installed = Apt.installed ["ccache"]
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
new file mode 100644
index 00000000..09047ce5
--- /dev/null
+++ b/src/Propellor/Property/Chroot.hs
@@ -0,0 +1,288 @@
+{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-}
+
+module Propellor.Property.Chroot (
+ debootstrapped,
+ bootstrapped,
+ provisioned,
+ Chroot(..),
+ ChrootBootstrapper(..),
+ Debootstrapped(..),
+ ChrootTarball(..),
+ noServices,
+ inChroot,
+ -- * Internal use
+ provisioned',
+ propagateChrootInfo,
+ propellChroot,
+ chain,
+ chrootSystem,
+) where
+
+import Propellor.Base
+import Propellor.Container
+import Propellor.Types.CmdLine
+import Propellor.Types.Chroot
+import Propellor.Types.Info
+import Propellor.Types.Core
+import Propellor.Property.Chroot.Util
+import qualified Propellor.Property.Debootstrap as Debootstrap
+import qualified Propellor.Property.Systemd.Core as Systemd
+import qualified Propellor.Property.File as File
+import qualified Propellor.Shim as Shim
+import Propellor.Property.Mount
+import Utility.FileMode
+
+import qualified Data.Map as M
+import Data.List.Utils
+import System.Posix.Directory
+import System.Console.Concurrent
+
+-- | Specification of a chroot. Normally you'll use `debootstrapped` or
+-- `bootstrapped` to construct a Chroot value.
+data Chroot where
+ Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
+
+instance IsContainer Chroot where
+ containerProperties (Chroot _ _ h) = containerProperties h
+ containerInfo (Chroot _ _ h) = containerInfo h
+ setContainerProperties (Chroot loc b h) ps = Chroot loc b (setContainerProperties h ps)
+
+chrootSystem :: Chroot -> Maybe System
+chrootSystem = fromInfoVal . fromInfo . containerInfo
+
+instance Show Chroot where
+ show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
+
+-- | Class of things that can do initial bootstrapping of an operating
+-- System in a chroot.
+class ChrootBootstrapper b where
+ -- | Do initial bootstrapping of an operating system in a chroot.
+ -- If the operating System is not supported, return
+ -- Left error message.
+ buildchroot :: b -> Maybe System -> FilePath -> Either String (Property Linux)
+
+-- | Use this to bootstrap a chroot by extracting a tarball.
+--
+-- The tarball is expected to contain a root directory (no top-level
+-- directory, also known as a "tarbomb").
+-- It may be optionally compressed with any format `tar` knows how to
+-- detect automatically.
+data ChrootTarball = ChrootTarball FilePath
+
+instance ChrootBootstrapper ChrootTarball where
+ buildchroot (ChrootTarball tb) _ loc = Right $
+ tightenTargets $ extractTarball loc tb
+
+extractTarball :: FilePath -> FilePath -> Property UnixLike
+extractTarball target src = check (unpopulated target) $
+ cmdProperty "tar" params
+ `assume` MadeChange
+ `requires` File.dirExists target
+ where
+ params =
+ [ "-C"
+ , target
+ , "-xf"
+ , src
+ ]
+
+-- | Use this to bootstrap a chroot with debootstrap.
+data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig
+
+instance ChrootBootstrapper Debootstrapped where
+ buildchroot (Debootstrapped cf) system loc = case system of
+ (Just s@(System (Debian _) _)) -> Right $ debootstrap s
+ (Just s@(System (Buntish _) _)) -> Right $ debootstrap s
+ (Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap."
+ Nothing -> Left "Cannot debootstrap; OS not specified"
+ where
+ debootstrap s = Debootstrap.built loc s cf
+
+-- | Defines a Chroot at the given location, built with debootstrap.
+--
+-- Properties can be added to configure the Chroot. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
+--
+-- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props
+-- > & osDebian Unstable "amd64"
+-- > & Apt.installed ["ghc", "haskell-platform"]
+-- > & ...
+debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
+debootstrapped conf = bootstrapped (Debootstrapped conf)
+
+-- | Defines a Chroot at the given location, bootstrapped with the
+-- specified ChrootBootstrapper.
+bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot
+bootstrapped bootstrapper location ps = Chroot location bootstrapper (host location ps)
+
+-- | Ensures that the chroot exists and is provisioned according to its
+-- properties.
+--
+-- Reverting this property removes the chroot. Anything mounted inside it
+-- is first unmounted. Note that it does not ensure that any processes
+-- that might be running inside the chroot are stopped.
+provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
+provisioned c = provisioned' (propagateChrootInfo c) c False
+
+provisioned'
+ :: (Property Linux -> Property (HasInfo + Linux))
+ -> Chroot
+ -> Bool
+ -> RevertableProperty (HasInfo + Linux) Linux
+provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
+ (propigator $ setup `describe` chrootDesc c "exists")
+ <!>
+ (teardown `describe` chrootDesc c "removed")
+ where
+ setup :: Property Linux
+ setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
+ `requires` built
+
+ built = case buildchroot bootstrapper (chrootSystem c) loc of
+ Right p -> p
+ Left e -> cantbuild e
+
+ cantbuild e = property (chrootDesc c "built") (error e)
+
+ teardown :: Property Linux
+ teardown = check (not <$> unpopulated loc) $
+ property ("removed " ++ loc) $
+ makeChange (removeChroot loc)
+
+propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
+propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
+ p `setInfoProperty` chrootInfo c
+
+chrootInfo :: Chroot -> Info
+chrootInfo (Chroot loc _ h) = mempty `addInfo`
+ mempty { _chroots = M.singleton loc h }
+
+-- | Propellor is run inside the chroot to provision it.
+propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
+propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
+ let d = localdir </> shimdir c
+ let me = localdir </> "propellor"
+ shim <- liftIO $ ifM (doesDirectoryExist d)
+ ( pure (Shim.file me d)
+ , Shim.setup me Nothing d
+ )
+ ifM (liftIO $ bindmount shim)
+ ( chainprovision shim
+ , return FailedChange
+ )
+ where
+ bindmount shim = ifM (doesFileExist (loc ++ shim))
+ ( return True
+ , do
+ let mntpnt = loc ++ localdir
+ createDirectoryIfMissing True mntpnt
+ boolSystem "mount"
+ [ Param "--bind"
+ , File localdir, File mntpnt
+ ]
+ )
+
+ chainprovision shim = do
+ parenthost <- asks hostName
+ cmd <- liftIO $ toChain parenthost c systemdonly
+ pe <- liftIO standardPathEnv
+ (p, cleanup) <- liftIO $ mkproc
+ [ shim
+ , "--continue"
+ , show cmd
+ ]
+ let p' = p { env = Just pe }
+ r <- liftIO $ withHandle StdoutHandle createProcessSuccess p'
+ processChainOutput
+ liftIO cleanup
+ return r
+
+toChain :: HostName -> Chroot -> Bool -> IO CmdLine
+toChain parenthost (Chroot loc _ _) systemdonly = do
+ onconsole <- isConsole <$> getMessageHandle
+ return $ ChrootChain parenthost loc systemdonly onconsole
+
+chain :: [Host] -> CmdLine -> IO ()
+chain hostlist (ChrootChain hn loc systemdonly onconsole) =
+ case findHostNoAlias hostlist hn of
+ Nothing -> errorMessage ("cannot find host " ++ hn)
+ Just parenthost -> case M.lookup loc (_chroots $ fromInfo $ hostInfo parenthost) of
+ Nothing -> errorMessage ("cannot find chroot " ++ loc ++ " on host " ++ hn)
+ Just h -> go h
+ where
+ go h = do
+ changeWorkingDirectory localdir
+ when onconsole forceConsole
+ onlyProcess (provisioningLock loc) $ do
+ r <- runPropellor (setInChroot h) $ ensureChildProperties $
+ if systemdonly
+ then [toChildProperty Systemd.installed]
+ else hostProperties h
+ flushConcurrentOutput
+ putStrLn $ "\n" ++ show r
+chain _ _ = errorMessage "bad chain command"
+
+inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
+inChrootProcess keepprocmounted (Chroot loc _ _) cmd = do
+ mountproc
+ return (proc "chroot" (loc:cmd), cleanup)
+ where
+ -- /proc needs to be mounted in the chroot for the linker to use
+ -- /proc/self/exe which is necessary for some commands to work
+ mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $
+ void $ mount "proc" "proc" procloc mempty
+
+ procloc = loc </> "proc"
+
+ cleanup
+ | keepprocmounted = noop
+ | otherwise = whenM (elem procloc <$> mountPointsBelow loc) $
+ umountLazy procloc
+
+provisioningLock :: FilePath -> FilePath
+provisioningLock containerloc = "chroot" </> mungeloc containerloc ++ ".lock"
+
+shimdir :: Chroot -> FilePath
+shimdir (Chroot loc _ _) = "chroot" </> mungeloc loc ++ ".shim"
+
+mungeloc :: FilePath -> String
+mungeloc = replace "/" "_"
+
+chrootDesc :: Chroot -> String -> String
+chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
+
+-- | Adding this property to a chroot prevents daemons and other services
+-- from being started, which is often something you want to prevent when
+-- building a chroot.
+--
+-- On Debian, this is accomplished by installing a </usr/sbin/policy-rc.d>
+-- script that does not let any daemons be started by packages that use
+-- invoke-rc.d. Reverting the property removes the script.
+--
+-- This property has no effect on non-Debian systems.
+noServices :: RevertableProperty UnixLike UnixLike
+noServices = setup <!> teardown
+ where
+ f = "/usr/sbin/policy-rc.d"
+ script = [ "#!/bin/sh", "exit 101" ]
+ setup = combineProperties "no services started" $ toProps
+ [ File.hasContent f script
+ , File.mode f (combineModes (readModes ++ executeModes))
+ ]
+ teardown = File.notPresent f
+
+-- | Check if propellor is currently running within a chroot.
+--
+-- This allows properties to check and avoid performing actions that
+-- should not be done in a chroot.
+inChroot :: Propellor Bool
+inChroot = extract . fromMaybe (InChroot False) . fromInfoVal <$> askInfo
+ where
+ extract (InChroot b) = b
+
+setInChroot :: Host -> Host
+setInChroot h = h { hostInfo = hostInfo h `addInfo` InfoVal (InChroot True) }
+
+newtype InChroot = InChroot Bool
+ deriving (Typeable, Show)
diff --git a/src/Propellor/Property/Chroot/Util.hs b/src/Propellor/Property/Chroot/Util.hs
new file mode 100644
index 00000000..ac703136
--- /dev/null
+++ b/src/Propellor/Property/Chroot/Util.hs
@@ -0,0 +1,33 @@
+module Propellor.Property.Chroot.Util where
+
+import Propellor.Property.Mount
+
+import Utility.Exception
+import Utility.Env
+import Utility.Directory
+
+import Control.Applicative
+import Prelude
+
+-- | When chrooting, it's useful to ensure that PATH has all the standard
+-- directories in it. This adds those directories to whatever PATH is
+-- already set.
+standardPathEnv :: IO [(String, String)]
+standardPathEnv = do
+ path <- getEnvDefault "PATH" "/bin"
+ addEntry "PATH" (path ++ stdPATH)
+ <$> getEnvironment
+
+stdPATH :: String
+stdPATH = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"
+
+-- | Removes the contents of a chroot. First, unmounts any filesystems
+-- mounted within it.
+removeChroot :: FilePath -> IO ()
+removeChroot c = do
+ unmountBelow c
+ removeDirectoryRecursive c
+
+-- | Returns true if a chroot directory is empty.
+unpopulated :: FilePath -> IO Bool
+unpopulated d = null <$> catchDefaultIO [] (dirContents d)
diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs
index 725f5757..6b84acb5 100644
--- a/src/Propellor/Property/Cmd.hs
+++ b/src/Propellor/Property/Cmd.hs
@@ -1,49 +1,98 @@
{-# LANGUAGE PackageImports #-}
+-- | This module lets you construct Properties by running commands and
+-- scripts. To get from an `UncheckedProperty` to a `Property`, it's
+-- up to the user to check if the command made a change to the system.
+--
+-- The best approach is to `check` a property, so that the command is only
+-- run when it needs to be. With this method, you avoid running the
+-- `cmdProperty` unnecessarily.
+--
+-- > check (not <$> userExists "bob")
+-- > (cmdProperty "useradd" ["bob"])
+--
+-- Sometimes it's just as expensive to check a property as it would be to
+-- run the command that ensures the property. So you can let the command
+-- run every time, and use `changesFile` or `checkResult` to determine if
+-- anything changed:
+--
+-- > cmdProperty "chmod" ["600", "/etc/secret"]
+-- > `changesFile` "/etc/secret"
+--
+-- Or you can punt and `assume` a change was made, but then propellor will
+-- always say it make a change, and `onChange` will always fire.
+--
+-- > cmdProperty "service" ["foo", "reload"]
+-- > `assume` MadeChange
+
module Propellor.Property.Cmd (
+ -- * Constricting properties running commands and scripts
cmdProperty,
cmdProperty',
+ cmdPropertyEnv,
+ Script,
scriptProperty,
userScriptProperty,
+ -- * Lower-level interface for running commands
+ CommandParam(..),
+ boolSystem,
+ boolSystemEnv,
+ safeSystem,
+ safeSystemEnv,
+ shellEscape,
+ createProcess,
+ waitForProcess,
) where
-import Control.Applicative
import Data.List
import "mtl" Control.Monad.Reader
+import Control.Applicative
+import Prelude
import Propellor.Types
import Propellor.Property
-import Utility.Monad
import Utility.SafeCommand
import Utility.Env
+import Utility.Process (createProcess, CreateProcess, waitForProcess)
-- | A property that can be satisfied by running a command.
--
-- The command must exit 0 on success.
-cmdProperty :: String -> [String] -> Property
-cmdProperty cmd params = cmdProperty' cmd params []
+cmdProperty :: String -> [String] -> UncheckedProperty UnixLike
+cmdProperty cmd params = cmdProperty' cmd params id
+
+cmdProperty' :: String -> [String] -> (CreateProcess -> CreateProcess) -> UncheckedProperty UnixLike
+cmdProperty' cmd params mkprocess = unchecked $ property desc $ liftIO $
+ cmdResult <$> boolSystem' cmd (map Param params) mkprocess
+ where
+ desc = unwords $ cmd : params
+
+cmdResult :: Bool -> Result
+cmdResult False = FailedChange
+cmdResult True = NoChange
-- | A property that can be satisfied by running a command,
--- with added environment.
-cmdProperty' :: String -> [String] -> [(String, String)] -> Property
-cmdProperty' cmd params env = property desc $ liftIO $ do
+-- with added environment variables in addition to the standard
+-- environment.
+cmdPropertyEnv :: String -> [String] -> [(String, String)] -> UncheckedProperty UnixLike
+cmdPropertyEnv cmd params env = unchecked $ property desc $ liftIO $ do
env' <- addEntries env <$> getEnvironment
- ifM (boolSystemEnv cmd (map Param params) (Just env'))
- ( return MadeChange
- , return FailedChange
- )
+ cmdResult <$> boolSystemEnv cmd (map Param params) (Just env')
where
desc = unwords $ cmd : params
--- | A property that can be satisfied by running a series of shell commands.
-scriptProperty :: [String] -> Property
+-- | A series of shell commands. (Without a leading hashbang.)
+type Script = [String]
+
+-- | A property that can be satisfied by running a script.
+scriptProperty :: Script -> UncheckedProperty UnixLike
scriptProperty script = cmdProperty "sh" ["-c", shellcmd]
where
shellcmd = intercalate " ; " ("set -e" : script)
--- | A property that can satisfied by running a series of shell commands,
+-- | A property that can satisfied by running a script
-- as user (cd'd to their home directory).
-userScriptProperty :: UserName -> [String] -> Property
-userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user]
+userScriptProperty :: User -> Script -> UncheckedProperty UnixLike
+userScriptProperty (User user) script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user]
where
shellcmd = intercalate " ; " ("set -e" : "cd" : script)
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
new file mode 100644
index 00000000..e69dc17d
--- /dev/null
+++ b/src/Propellor/Property/Concurrent.hs
@@ -0,0 +1,135 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+-- | Propellor properties can be made to run concurrently, using this
+-- module. This can speed up propellor, at the expense of using more CPUs
+-- and other resources.
+--
+-- It's up to you to make sure that properties that you make run concurrently
+-- don't implicitly depend on one-another. The worst that can happen
+-- though, is that propellor fails to ensure some of the properties,
+-- and tells you what went wrong.
+--
+-- Another potential problem is that output of concurrent properties could
+-- interleave into a scrambled mess. This is mostly prevented; all messages
+-- output by propellor are concurrency safe, including `errorMessage`,
+-- `infoMessage`, etc. However, if you write a property that directly
+-- uses `print` or `putStrLn`, you can still experience this problem.
+--
+-- Similarly, when properties run external commands, the command's output
+-- can be a problem for concurrency. No need to worry;
+-- `Propellor.Property.Cmd.createProcess` is concurrent output safe
+-- (it actually uses `Propellor.Message.createProcessConcurrent`), and
+-- everything else in propellor that runs external commands is built on top
+-- of that. Of course, if you import System.Process and use it in a
+-- property, you can bypass that and shoot yourself in the foot.
+--
+-- Finally, anything that directly accesses the tty can bypass
+-- these protections. That's sometimes done for eg, password prompts.
+-- A well-written property should avoid running interactive commands
+-- anyway.
+
+module Propellor.Property.Concurrent (
+ concurrently,
+ concurrentList,
+ props,
+ getNumProcessors,
+ concurrentSatisfy,
+) where
+
+import Propellor.Base
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
+
+import Control.Concurrent
+import qualified Control.Concurrent.Async as A
+import GHC.Conc (getNumProcessors)
+import Control.Monad.RWS.Strict
+
+-- | Ensures two properties concurrently.
+--
+-- > & foo `concurrently` bar
+--
+-- To ensure three properties concurrently, just use this combinator twice:
+--
+-- > & foo `concurrently` bar `concurrently` baz
+concurrently
+ :: (IsProp p1, IsProp p2, Combines p1 p2, IsProp (CombinedType p1 p2))
+ => p1
+ -> p2
+ -> CombinedType p1 p2
+concurrently p1 p2 = (combineWith go go p1 p2)
+ `describe` d
+ where
+ d = getDesc p1 ++ " `concurrently` " ++ getDesc p2
+ -- Increase the number of capabilities right up to the number of
+ -- processors, so that A `concurrently` B `concurrently` C
+ -- runs all 3 properties on different processors when possible.
+ go a1 a2 = do
+ n <- liftIO getNumProcessors
+ withCapabilities n $
+ concurrentSatisfy a1 a2
+
+-- | Ensures all the properties in the list, with a specified amount of
+-- concurrency.
+--
+-- > concurrentList (pure 2) "demo" $ props
+-- > & foo
+-- > & bar
+-- > & baz
+--
+-- The above example will run foo and bar concurrently, and once either of
+-- those 2 properties finishes, will start running baz.
+concurrentList :: SingI metatypes => IO Int -> Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+concurrentList getn d (Props ps) = property d go `addChildren` ps
+ where
+ go = do
+ n <- liftIO getn
+ withCapabilities n $
+ startworkers n =<< liftIO (newMVar ps)
+ startworkers n q
+ | n < 1 = return NoChange
+ | n == 1 = worker q NoChange
+ | otherwise =
+ worker q NoChange
+ `concurrentSatisfy`
+ startworkers (n-1) q
+ worker q r = do
+ v <- liftIO $ modifyMVar q $ \v -> case v of
+ [] -> return ([], Nothing)
+ (p:rest) -> return (rest, Just p)
+ case v of
+ Nothing -> return r
+ Just p -> do
+ hn <- asks hostName
+ r' <- actionMessageOn hn
+ (getDesc p)
+ (getSatisfy p)
+ worker q (r <> r')
+
+-- | Run an action with the number of capabiities increased as necessary to
+-- allow running on the specified number of cores.
+--
+-- Never increases the number of capabilities higher than the actual number
+-- of processors.
+withCapabilities :: Int -> Propellor a -> Propellor a
+withCapabilities n a = bracket setup cleanup (const a)
+ where
+ setup = do
+ np <- liftIO getNumProcessors
+ let n' = min n np
+ c <- liftIO getNumCapabilities
+ when (n' > c) $
+ liftIO $ setNumCapabilities n'
+ return c
+ cleanup = liftIO . setNumCapabilities
+
+-- | Running Propellor actions concurrently.
+concurrentSatisfy :: Propellor Result -> Propellor Result -> Propellor Result
+concurrentSatisfy a1 a2 = do
+ h <- ask
+ ((r1, w1), (r2, w2)) <- liftIO $
+ runp a1 h `A.concurrently` runp a2 h
+ tell (w1 <> w2)
+ return (r1 <> r2)
+ where
+ runp a h = evalRWST (runWithHost (catchPropellor a)) h ()
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
new file mode 100644
index 00000000..8aa18d20
--- /dev/null
+++ b/src/Propellor/Property/Conductor.hs
@@ -0,0 +1,337 @@
+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeFamilies #-}
+
+-- | This module adds conductors to propellor. A conductor is a Host that
+-- is responsible for running propellor on other hosts
+--
+-- This eliminates the need to manually run propellor --spin to
+-- update the conducted hosts, and can be used to orchestrate updates
+-- to hosts.
+--
+-- The conductor needs to be able to ssh to the hosts it conducts,
+-- and run propellor, as root. To this end,
+-- the `Propellor.Property.Ssh.knownHost` property is automatically
+-- added to the conductor, so it knows the host keys of the relevant hosts.
+-- Also, each conducted host is configured to let its conductor
+-- ssh in as root, by automatically adding the
+-- `Propellor.Property.Ssh.authorizedKeysFrom` property.
+--
+-- It's left up to you to use `Propellor.Property.Ssh.userKeys` to
+-- configure the ssh keys for the root user on conductor hosts,
+-- and to use `Ssh.hostKeys` to configure the host keys for the
+-- conducted hosts.
+--
+-- For example, if you have some webservers and a dnsserver,
+-- and want the master host to conduct all of them:
+--
+-- > import Propellor
+-- > import Propellor.Property.Conductor
+-- > import qualified Propellor.Property.Ssh as Ssh
+-- > import qualified Propellor.Property.Cron as Cron
+-- >
+-- > main = defaultMain (orchestrate hosts)
+-- >
+-- > hosts =
+-- > [ master
+-- > , dnsserver
+-- > ] ++ webservers
+-- >
+-- > dnsserver = host "dns.example.com"
+-- > & Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI")]
+-- > & ...
+-- >
+-- > webservers =
+-- > [ host "www1.example.com"
+-- > & Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAICfFntnesZcYz2B2T41ay45igfckXRSh5uVffkuCQkLv")]
+-- > & ...
+-- > , ...
+-- > ]
+-- >
+-- > master = host "master.example.com"
+-- > & Ssh.userKeys (User "root") [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFWD0Hau5FDLeNrDHKilNMKm9c68R3WD+NJOp2jPWvJV")]
+-- > & conducts webservers
+-- > `before` conducts dnsserver
+-- > & Cron.runPropellor
+--
+-- Notice that, in the above example, the the webservers are conducted
+-- first. Only once the webservers have successfully been set up is the
+-- dnsserver updated. This way, when adding a new web server, the dns
+-- won't list it until it's ready.
+--
+-- There can be multiple conductors, and conductors can conduct other
+-- conductors if you need such a hierarchy. (Loops in the hierarchy, such
+-- as a host conducting itself, are detected and automatically broken.)
+--
+-- While it's allowed for a single host to be conducted by
+-- multiple conductors, the results can be discordent.
+-- Since only one propellor process can be run on a host at a time,
+-- one of the conductors will fail to communicate with it.
+--
+-- Note that a conductor can see all PrivData of the hosts it conducts.
+
+module Propellor.Property.Conductor (
+ orchestrate,
+ Conductable(..),
+) where
+
+import Propellor.Base
+import Propellor.Container
+import Propellor.Spin (spin')
+import Propellor.PrivData.Paths
+import Propellor.Types.Info
+import qualified Propellor.Property.Ssh as Ssh
+
+import qualified Data.Set as S
+
+-- | Class of things that can be conducted.
+--
+-- There are instances for single hosts, and for lists of hosts.
+-- With a list, each listed host will be conducted in turn. Failure to conduct
+-- one host does not prevent conducting subsequent hosts in the list, but
+-- will be propagated as an overall failure of the property.
+class Conductable c where
+ conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
+
+instance Conductable Host where
+ conducts h = conductorFor h <!> notConductorFor h
+
+instance Conductable [Host] where
+ conducts hs =
+ propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs)
+ <!>
+ propertyList desc (toProps $ map (undoRevertableProperty . conducts) hs)
+ where
+ desc = cdesc $ unwords $ map hostName hs
+
+data Orchestra
+ = Conductor Host [Orchestra]
+ | Conducted Host
+
+instance Show Orchestra where
+ show (Conductor h l) = "Conductor " ++ hostName h ++ " (" ++ show l ++ ")"
+ show (Conducted h) = "Conducted " ++ hostName h
+
+fullOrchestra :: Orchestra -> Bool
+fullOrchestra (Conductor _ _) = True
+fullOrchestra (Conducted _) = False
+
+topHost :: Orchestra -> Host
+topHost (Conducted h) = h
+topHost (Conductor h _) = h
+
+allHosts :: Orchestra -> [Host]
+allHosts (Conducted h) = [h]
+allHosts (Conductor h l) = h : concatMap allHosts l
+
+-- Makes an Orchestra for the host, and any hosts it's conducting.
+mkOrchestra :: Host -> Orchestra
+mkOrchestra = fromJust . go S.empty
+ where
+ go seen h
+ | S.member (hostName h) seen = Nothing -- break loop
+ | otherwise = Just $ case fromInfo (hostInfo h) of
+ ConductorFor [] -> Conducted h
+ ConductorFor l ->
+ let seen' = S.insert (hostName h) seen
+ in Conductor h (mapMaybe (go seen') l)
+
+-- Combines the two orchestras, if there's a place, or places where they
+-- can be grafted together.
+combineOrchestras :: Orchestra -> Orchestra -> Maybe Orchestra
+combineOrchestras a b = combineOrchestras' a b <|> combineOrchestras' b a
+
+combineOrchestras' :: Orchestra -> Orchestra -> Maybe Orchestra
+combineOrchestras' (Conducted h) b
+ | sameHost h (topHost b) = Just b
+ | otherwise = Nothing
+combineOrchestras' (Conductor h os) (Conductor h' os')
+ | sameHost h h' = Just $ Conductor h (concatMap combineos os')
+ where
+ combineos o = case mapMaybe (`combineOrchestras` o) os of
+ [] -> [o]
+ os'' -> os''
+combineOrchestras' a@(Conductor h _) (Conducted h')
+ | sameHost h h' = Just a
+combineOrchestras' (Conductor h os) b
+ | null (catMaybes (map snd osgrafts)) = Nothing
+ | otherwise = Just $ Conductor h (map (uncurry fromMaybe) osgrafts)
+ where
+ osgrafts = zip os (map (`combineOrchestras` b) os)
+
+sameHost :: Host -> Host -> Bool
+sameHost a b = hostName a == hostName b
+
+-- Removes any loops that may be present in the Orchestra involving
+-- the passed Host. This is a matter of traversing the Orchestra
+-- top-down, and removing all occurrances of the host after the first
+-- one seen.
+deloop :: Host -> Orchestra -> Orchestra
+deloop _ (Conducted h) = Conducted h
+deloop thehost (Conductor htop ostop) = Conductor htop $
+ fst $ seekh [] ostop (sameHost htop thehost)
+ where
+ seekh l [] seen = (l, seen)
+ seekh l ((Conducted h) : rest) seen
+ | sameHost h thehost =
+ if seen
+ then seekh l rest seen
+ else seekh (Conducted h : l) rest True
+ | otherwise = seekh (Conducted h:l) rest seen
+ seekh l ((Conductor h os) : rest) seen
+ | sameHost h thehost =
+ if seen
+ then seekh l rest seen
+ else
+ let (os', _seen') = seekh [] os True
+ in seekh (Conductor h os' : l) rest True
+ | otherwise =
+ let (os', seen') = seekh [] os seen
+ in seekh (Conductor h os' : l) rest seen'
+
+-- Extracts the Orchestras from a list of hosts.
+--
+-- Method: For each host that is a conductor, check the
+-- list of orchesteras to see if any already contain that host, or
+-- any of the hosts it conducts. If so, add the host to that
+-- orchestra. If not, start a new orchestra.
+--
+-- The result is a set of orchestras, which are each fully disconnected
+-- from the other. Some may contain loops.
+extractOrchestras :: [Host] -> [Orchestra]
+extractOrchestras = filter fullOrchestra . go [] . map mkOrchestra
+ where
+ go os [] = os
+ go os (o:rest) =
+ let os' = zip os (map (combineOrchestras o) os)
+ in case catMaybes (map snd os') of
+ [] -> go (o:os) rest
+ [_] -> go (map (uncurry fromMaybe) os') rest
+ _ -> error "Bug: Host somehow ended up in multiple Orchestras!"
+
+-- | Pass this a list of all your hosts; it will finish setting up
+-- orchestration as configured by the `conducts` properties you add to
+-- hosts.
+--
+-- > main = defaultMain $ orchestrate hosts
+orchestrate :: [Host] -> [Host]
+orchestrate hs = map go hs
+ where
+ go h
+ | isOrchestrated (fromInfo (hostInfo h)) = h
+ | otherwise = foldl orchestrate' (removeold h) (map (deloop h) os)
+ os = extractOrchestras hs
+
+ removeold h = foldl removeold' h (oldconductorsof h)
+ removeold' h oldconductor = setContainerProps h $ containerProps h
+ ! conductedBy oldconductor
+
+ oldconductors = zip hs (map (fromInfo . hostInfo) hs)
+ oldconductorsof h = flip mapMaybe oldconductors $
+ \(oldconductor, NotConductorFor l) ->
+ if any (sameHost h) l
+ then Just oldconductor
+ else Nothing
+
+orchestrate' :: Host -> Orchestra -> Host
+orchestrate' h (Conducted _) = h
+orchestrate' h (Conductor c l)
+ | sameHost h c = cont $ addConductorPrivData h (concatMap allHosts l)
+ | any (sameHost h) (map topHost l) = cont $
+ setContainerProps h $ containerProps h
+ & conductedBy c
+ | otherwise = cont h
+ where
+ cont h' = foldl orchestrate' h' l
+
+-- The host this property is added to becomes the conductor for the
+-- specified Host. Note that `orchestrate` must be used for this property
+-- to have any effect.
+conductorFor :: Host -> Property (HasInfo + UnixLike)
+conductorFor h = go
+ `setInfoProperty` (toInfo (ConductorFor [h]))
+ `requires` setupRevertableProperty (conductorKnownHost h)
+ `requires` Ssh.installed
+ where
+ desc = cdesc (hostName h)
+
+ go :: Property UnixLike
+ go = property desc $ ifM (isOrchestrated <$> askInfo)
+ ( do
+ pm <- liftIO $ filterPrivData h
+ <$> readPrivDataFile privDataLocal
+ liftIO $ spin' (Just pm) Nothing (hostName h) h
+ -- Don't know if the spin made a change to
+ -- the remote host or not, but in any case,
+ -- the local host was not changed.
+ noChange
+ , do
+ warningMessage "Can't conduct; either orchestrate has not been used, or there is a conductor loop."
+ return FailedChange
+ )
+
+-- Reverts conductorFor.
+notConductorFor :: Host -> Property (HasInfo + UnixLike)
+notConductorFor h = (doNothing :: Property UnixLike)
+ `setInfoProperty` (toInfo (NotConductorFor [h]))
+ `describe` desc
+ `requires` undoRevertableProperty (conductorKnownHost h)
+ where
+ desc = "not " ++ cdesc (hostName h)
+
+conductorKnownHost :: Host -> RevertableProperty UnixLike UnixLike
+conductorKnownHost h =
+ mk Ssh.knownHost
+ <!>
+ mk Ssh.unknownHost
+ where
+ mk p = p [h] (hostName h) (User "root")
+
+-- Gives a conductor access to all the PrivData of the specified hosts.
+-- This allows it to send it on the the hosts when conducting it.
+--
+-- This is not done in conductorFor, so that it can be added
+-- at the orchestration stage, and so is not added when there's a loop.
+addConductorPrivData :: Host -> [Host] -> Host
+addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
+ where
+ i = mempty
+ `addInfo` mconcat (map privinfo hs)
+ `addInfo` Orchestrated (Any True)
+ privinfo h' = forceHostContext (hostName h') $ fromInfo (hostInfo h')
+
+-- Use this property to let the specified conductor ssh in and run propellor.
+conductedBy :: Host -> RevertableProperty UnixLike UnixLike
+conductedBy h = (setup <!> teardown)
+ `describe` ("conducted by " ++ hostName h)
+ where
+ setup = User "root" `Ssh.authorizedKeysFrom` (User "root", h)
+ `requires` Ssh.installed
+ teardown = User "root" `Ssh.unauthorizedKeysFrom` (User "root", h)
+
+cdesc :: String -> Desc
+cdesc n = "conducting " ++ n
+
+-- A Host's Info indicates when it's a conductor for hosts, and when it's
+-- stopped being a conductor.
+newtype ConductorFor = ConductorFor [Host]
+ deriving (Typeable, Monoid)
+newtype NotConductorFor = NotConductorFor [Host]
+ deriving (Typeable, Monoid)
+
+instance Show ConductorFor where
+ show (ConductorFor l) = "ConductorFor " ++ show (map hostName l)
+instance Show NotConductorFor where
+ show (NotConductorFor l) = "NotConductorFor " ++ show (map hostName l)
+
+instance IsInfo ConductorFor where
+ propagateInfo _ = False
+instance IsInfo NotConductorFor where
+ propagateInfo _ = False
+
+-- Added to Info when a host has been orchestrated.
+newtype Orchestrated = Orchestrated Any
+ deriving (Typeable, Monoid, Show)
+instance IsInfo Orchestrated where
+ propagateInfo _ = False
+
+isOrchestrated :: Orchestrated -> Bool
+isOrchestrated (Orchestrated v) = getAny v
diff --git a/src/Propellor/Property/ConfFile.hs b/src/Propellor/Property/ConfFile.hs
new file mode 100644
index 00000000..270e04f1
--- /dev/null
+++ b/src/Propellor/Property/ConfFile.hs
@@ -0,0 +1,103 @@
+module Propellor.Property.ConfFile (
+ -- * Generic conffiles with sections
+ SectionStart,
+ SectionPast,
+ AdjustSection,
+ InsertSection,
+ adjustSection,
+ -- * Windows .ini files
+ IniSection,
+ IniKey,
+ containsIniSetting,
+ lacksIniSection,
+) where
+
+import Propellor.Base
+import Propellor.Property.File
+
+import Data.List (isPrefixOf, foldl')
+
+-- | find the line that is the start of the wanted section (eg, == "<Foo>")
+type SectionStart = Line -> Bool
+-- | find a line that indicates we are past the section
+-- (eg, a new section header)
+type SectionPast = Line -> Bool
+-- | run on all lines in the section, including the SectionStart line;
+-- can add, delete, and modify lines, or even delete entire section
+type AdjustSection = [Line] -> [Line]
+-- | if SectionStart does not find the section in the file, this is used to
+-- insert the section somewhere within it
+type InsertSection = [Line] -> [Line]
+
+-- | Adjusts a section of conffile.
+adjustSection
+ :: Desc
+ -> SectionStart
+ -> SectionPast
+ -> AdjustSection
+ -> InsertSection
+ -> FilePath
+ -> Property UnixLike
+adjustSection desc start past adjust insert = fileProperty desc go
+ where
+ go ls = let (pre, wanted, post) = foldl' find ([], [], []) ls
+ in if null wanted
+ then insert ls
+ else pre ++ (adjust wanted) ++ post
+ find (pre, wanted, post) l
+ | null wanted && null post && (not . start) l =
+ (pre ++ [l], wanted, post)
+ | (start l && null wanted && null post)
+ || ((not . null) wanted && null post && (not . past) l) =
+ (pre, wanted ++ [l], post)
+ | otherwise = (pre, wanted, post ++ [l])
+
+-- | Name of a section of an .ini file. This value is put
+-- in square braces to generate the section header.
+type IniSection = String
+
+-- | Name of a configuration setting within a .ini file.
+type IniKey = String
+
+iniHeader :: IniSection -> String
+iniHeader header = '[' : header ++ "]"
+
+adjustIniSection
+ :: Desc
+ -> IniSection
+ -> AdjustSection
+ -> InsertSection
+ -> FilePath
+ -> Property UnixLike
+adjustIniSection desc header =
+ adjustSection
+ desc
+ (== iniHeader header)
+ ("[" `isPrefixOf`)
+
+-- | Ensures that a .ini file exists and contains a section
+-- with a key=value setting.
+containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike
+containsIniSetting f (header, key, value) =
+ adjustIniSection
+ (f ++ " section [" ++ header ++ "] contains " ++ key ++ "=" ++ value)
+ header
+ go
+ (++ [confheader, confline]) -- add missing section at end
+ f
+ where
+ confheader = iniHeader header
+ confline = key ++ "=" ++ value
+ go [] = [confline]
+ go (l:ls) = if isKeyVal l then confline : ls else l : (go ls)
+ isKeyVal x = (filter (/= ' ') . takeWhile (/= '=')) x `elem` [key, '#':key]
+
+-- | Ensures that a .ini file does not contain the specified section.
+lacksIniSection :: FilePath -> IniSection -> Property UnixLike
+lacksIniSection f header =
+ adjustIniSection
+ (f ++ " lacks section [" ++ header ++ "]")
+ header
+ (const []) -- remove all lines of section
+ id -- add no lines if section is missing
+ f
diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs
index d55c3dbb..0966a7e5 100644
--- a/src/Propellor/Property/Cron.hs
+++ b/src/Propellor/Property/Cron.hs
@@ -1,50 +1,72 @@
module Propellor.Property.Cron where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
-import Utility.SafeCommand
+import Propellor.Bootstrap
import Utility.FileMode
import Data.Char
-type CronTimes = String
+-- | When to run a cron job.
+--
+-- The Daily, Monthly, and Weekly options allow the cron job to be run
+-- by anacron, which is useful for non-servers.
+data Times
+ = Times String -- ^ formatted as in crontab(5)
+ | Daily
+ | Weekly
+ | Monthly
--- | Installs a cron job, run as a specified user, in a particular
--- directory. Note that the Desc must be unique, as it is used for the
--- cron.d/ filename.
---
+-- | Installs a cron job, that will run as a specified user in a particular
+-- directory. Note that the Desc must be unique, as it is used for the
+-- cron job filename.
+--
-- Only one instance of the cron job is allowed to run at a time, no matter
-- how long it runs. This is accomplished using flock locking of the cron
-- job file.
--
-- The cron job's output will only be emailed if it exits nonzero.
-job :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
-job desc times user cddir command = combineProperties ("cronned " ++ desc)
- [ cronjobfile `File.hasContent`
- [ "# Generated by propellor"
+job :: Desc -> Times -> User -> FilePath -> String -> Property DebianLike
+job desc times (User u) cddir command = combineProperties ("cronned " ++ desc) $ props
+ & Apt.serviceInstalledRunning "cron"
+ & Apt.installed ["util-linux", "moreutils"]
+ & cronjobfile `File.hasContent`
+ [ case times of
+ Times _ -> ""
+ _ -> "#!/bin/sh\nset -e"
+ , "# Generated by propellor"
, ""
, "SHELL=/bin/sh"
, "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
, ""
- , times ++ "\t" ++ user ++ "\tchronic " ++ shellEscape scriptfile
+ , case times of
+ Times t -> t ++ "\t" ++ u ++ "\tchronic " ++ shellEscape scriptfile
+ _ -> case u of
+ "root" -> "chronic " ++ shellEscape scriptfile
+ _ -> "chronic su " ++ u ++ " -c " ++ shellEscape scriptfile
]
- -- Use a separate script because it makes the cron job name
+ & case times of
+ Times _ -> doNothing
+ _ -> cronjobfile `File.mode` combineModes (readModes ++ executeModes)
+ -- Use a separate script because it makes the cron job name
-- prettier in emails, and also allows running the job manually.
- , scriptfile `File.hasContent`
+ & scriptfile `File.hasContent`
[ "#!/bin/sh"
, "# Generated by propellor"
, "set -e"
, "flock -n " ++ shellEscape cronjobfile
++ " sh -c " ++ shellEscape cmdline
]
- , scriptfile `File.mode` combineModes (readModes ++ executeModes)
- ]
- `requires` Apt.serviceInstalledRunning "cron"
- `requires` Apt.installed ["util-linux", "moreutils"]
+ & scriptfile `File.mode` combineModes (readModes ++ executeModes)
where
cmdline = "cd " ++ cddir ++ " && ( " ++ command ++ " )"
- cronjobfile = "/etc/cron.d/" ++ name
+ cronjobfile = "/etc" </> cronjobdir </> name
+ cronjobdir = case times of
+ Times _ -> "cron.d"
+ Daily -> "cron.daily"
+ Weekly -> "cron.weekly"
+ Monthly -> "cron.monthly"
scriptfile = "/usr/local/bin/" ++ name ++ "_cronjob"
name = map sanitize desc
sanitize c
@@ -52,10 +74,13 @@ job desc times user cddir command = combineProperties ("cronned " ++ desc)
| otherwise = '_'
-- | Installs a cron job, and runs it niced and ioniced.
-niceJob :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
+niceJob :: Desc -> Times -> User -> FilePath -> String -> Property DebianLike
niceJob desc times user cddir command = job desc times user cddir
("nice ionice -c 3 sh -c " ++ shellEscape command)
-- | Installs a cron job to run propellor.
-runPropellor :: CronTimes -> Property
-runPropellor times = niceJob "propellor" times "root" localdir "make"
+runPropellor :: Times -> Property UnixLike
+runPropellor times = withOS "propellor cron job" $ \w o ->
+ ensureProperty w $
+ niceJob "propellor" times (User "root") localdir
+ (bootstrapPropellorCommand o ++ "; ./propellor")
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
new file mode 100644
index 00000000..b86d8e0b
--- /dev/null
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -0,0 +1,156 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+
+module Propellor.Property.DebianMirror
+ ( DebianPriority (..)
+ , showPriority
+ , mirror
+ , RsyncExtra (..)
+ , Method (..)
+ , DebianMirror
+ , debianMirrorHostName
+ , debianMirrorSuites
+ , debianMirrorArchitectures
+ , debianMirrorSections
+ , debianMirrorSourceBool
+ , debianMirrorPriorities
+ , debianMirrorMethod
+ , debianMirrorKeyring
+ , debianMirrorRsyncExtra
+ , mkDebianMirror
+ ) where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Cron as Cron
+import qualified Propellor.Property.User as User
+
+import Data.List
+
+
+data DebianPriority = Essential | Required | Important | Standard | Optional | Extra
+ deriving (Show, Eq)
+
+showPriority :: DebianPriority -> String
+showPriority Essential = "essential"
+showPriority Required = "required"
+showPriority Important = "important"
+showPriority Standard = "standard"
+showPriority Optional = "optional"
+showPriority Extra = "extra"
+
+data RsyncExtra = Doc | Indices | Tools | Trace
+ deriving (Show, Eq)
+
+showRsyncExtra :: RsyncExtra -> String
+showRsyncExtra Doc = "doc"
+showRsyncExtra Indices = "indices"
+showRsyncExtra Tools = "tools"
+showRsyncExtra Trace = "trace"
+
+data Method = Ftp | Http | Https | Rsync | MirrorFile
+
+showMethod :: Method -> String
+showMethod Ftp = "ftp"
+showMethod Http = "http"
+showMethod Https = "https"
+showMethod Rsync = "rsync"
+showMethod MirrorFile = "file"
+
+-- | To get a new DebianMirror and set options, use:
+--
+-- > mkDebianMirror mymirrordir mycrontimes
+-- > . debianMirrorHostName "otherhostname"
+-- > . debianMirrorSourceBool True
+
+data DebianMirror = DebianMirror
+ { _debianMirrorHostName :: HostName
+ , _debianMirrorDir :: FilePath
+ , _debianMirrorSuites :: [DebianSuite]
+ , _debianMirrorArchitectures :: [Architecture]
+ , _debianMirrorSections :: [Apt.Section]
+ , _debianMirrorSourceBool :: Bool
+ , _debianMirrorPriorities :: [DebianPriority]
+ , _debianMirrorMethod :: Method
+ , _debianMirrorKeyring :: FilePath
+ , _debianMirrorRsyncExtra :: [RsyncExtra]
+ , _debianMirrorCronTimes :: Cron.Times
+ }
+
+mkDebianMirror :: FilePath -> Cron.Times -> DebianMirror
+mkDebianMirror dir crontimes = DebianMirror
+ { _debianMirrorHostName = "httpredir.debian.org"
+ , _debianMirrorDir = dir
+ , _debianMirrorSuites = []
+ , _debianMirrorArchitectures = []
+ , _debianMirrorSections = []
+ , _debianMirrorSourceBool = False
+ , _debianMirrorPriorities = []
+ , _debianMirrorMethod = Http
+ , _debianMirrorKeyring = "/usr/share/keyrings/debian-archive-keyring.gpg"
+ , _debianMirrorRsyncExtra = [Trace]
+ , _debianMirrorCronTimes = crontimes
+ }
+
+debianMirrorHostName :: HostName -> DebianMirror -> DebianMirror
+debianMirrorHostName hn m = m { _debianMirrorHostName = hn }
+
+debianMirrorSuites :: [DebianSuite] -> DebianMirror -> DebianMirror
+debianMirrorSuites s m = m { _debianMirrorSuites = s }
+
+debianMirrorArchitectures :: [Architecture] -> DebianMirror -> DebianMirror
+debianMirrorArchitectures a m = m { _debianMirrorArchitectures = a }
+
+debianMirrorSections :: [Apt.Section] -> DebianMirror -> DebianMirror
+debianMirrorSections s m = m { _debianMirrorSections = s }
+
+debianMirrorSourceBool :: Bool -> DebianMirror -> DebianMirror
+debianMirrorSourceBool s m = m { _debianMirrorSourceBool = s }
+
+debianMirrorPriorities :: [DebianPriority] -> DebianMirror -> DebianMirror
+debianMirrorPriorities p m = m { _debianMirrorPriorities = p }
+
+debianMirrorMethod :: Method -> DebianMirror -> DebianMirror
+debianMirrorMethod me m = m { _debianMirrorMethod = me }
+
+debianMirrorKeyring :: FilePath -> DebianMirror -> DebianMirror
+debianMirrorKeyring k m = m { _debianMirrorKeyring = k }
+
+debianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror
+debianMirrorRsyncExtra r m = m { _debianMirrorRsyncExtra = r }
+
+mirror :: DebianMirror -> Property DebianLike
+mirror mirror' = propertyList ("Debian mirror " ++ dir) $ props
+ & Apt.installed ["debmirror"]
+ & User.accountFor (User "debmirror")
+ & File.dirExists dir
+ & File.ownerGroup dir (User "debmirror") (Group "debmirror")
+ & check (not . and <$> mapM suitemirrored suites)
+ (cmdProperty "debmirror" args)
+ `describe` "debmirror setup"
+ & Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/"
+ (unwords ("/usr/bin/debmirror" : args))
+ where
+ dir = _debianMirrorDir mirror'
+ suites = _debianMirrorSuites mirror'
+ suitemirrored suite = doesDirectoryExist $ dir </> "dists" </> Apt.showSuite suite
+ architecturearg = intercalate ","
+ suitearg = intercalate "," $ map Apt.showSuite suites
+ priorityRegex pp = "(" ++ intercalate "|" (map showPriority pp) ++ ")"
+ rsyncextraarg [] = "none"
+ rsyncextraarg res = intercalate "," $ map showRsyncExtra res
+ args =
+ [ "--dist" , suitearg
+ , "--arch", architecturearg $ _debianMirrorArchitectures mirror'
+ , "--section", intercalate "," $ _debianMirrorSections mirror'
+ , "--limit-priority", "\"" ++ priorityRegex (_debianMirrorPriorities mirror') ++ "\""
+ ]
+ ++
+ (if _debianMirrorSourceBool mirror' then [] else ["--nosource"])
+ ++
+ [ "--host", _debianMirrorHostName mirror'
+ , "--method", showMethod $ _debianMirrorMethod mirror'
+ , "--rsync-extra", rsyncextraarg $ _debianMirrorRsyncExtra mirror'
+ , "--keyring", _debianMirrorKeyring mirror'
+ , dir
+ ]
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
new file mode 100644
index 00000000..87f30776
--- /dev/null
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -0,0 +1,277 @@
+module Propellor.Property.Debootstrap (
+ Url,
+ DebootstrapConfig(..),
+ built,
+ built',
+ extractSuite,
+ installed,
+ sourceInstall,
+ programPath,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.Chroot.Util
+import Utility.Path
+import Utility.FileMode
+
+import Data.List
+import Data.Char
+import System.Posix.Directory
+import System.Posix.Files
+
+type Url = String
+
+-- | A monoid for debootstrap configuration.
+-- mempty is a default debootstrapped system.
+data DebootstrapConfig
+ = DefaultConfig
+ | MinBase
+ | BuilddD
+ | DebootstrapParam String
+ | DebootstrapConfig :+ DebootstrapConfig
+ deriving (Show)
+
+instance Monoid DebootstrapConfig where
+ mempty = DefaultConfig
+ mappend = (:+)
+
+toParams :: DebootstrapConfig -> [CommandParam]
+toParams DefaultConfig = []
+toParams MinBase = [Param "--variant=minbase"]
+toParams BuilddD = [Param "--variant=buildd"]
+toParams (DebootstrapParam p) = [Param p]
+toParams (c1 :+ c2) = toParams c1 <> toParams c2
+
+-- | Builds a chroot in the given directory using debootstrap.
+--
+-- The System can be any OS and architecture that debootstrap
+-- and the kernel support.
+built :: FilePath -> System -> DebootstrapConfig -> Property Linux
+built target system config = built' (setupRevertableProperty installed) target system config
+
+built' :: Property Linux -> FilePath -> System -> DebootstrapConfig -> Property Linux
+built' installprop target system@(System _ arch) config =
+ check (unpopulated target <||> ispartial) setupprop
+ `requires` installprop
+ where
+ setupprop :: Property Linux
+ setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
+ createDirectoryIfMissing True target
+ -- Don't allow non-root users to see inside the chroot,
+ -- since doing so can allow them to do various attacks
+ -- including hard link farming suid programs for later
+ -- exploitation.
+ modifyFileMode target (removeModes [otherReadMode, otherExecuteMode, otherWriteMode])
+ suite <- case extractSuite system of
+ Nothing -> errorMessage $ "don't know how to debootstrap " ++ show system
+ Just s -> pure s
+ let params = toParams config ++
+ [ Param $ "--arch=" ++ arch
+ , Param suite
+ , Param target
+ ]
+ cmd <- fromMaybe "debootstrap" <$> programPath
+ de <- standardPathEnv
+ ifM (boolSystemEnv cmd params (Just de))
+ ( do
+ fixForeignDev target
+ return MadeChange
+ , return FailedChange
+ )
+
+ -- A failed debootstrap run will leave a debootstrap directory;
+ -- recover by deleting it and trying again.
+ ispartial = ifM (doesDirectoryExist (target </> "debootstrap"))
+ ( do
+ removeChroot target
+ return True
+ , return False
+ )
+
+extractSuite :: System -> Maybe String
+extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
+extractSuite (System (Buntish r) _) = Just r
+extractSuite (System (FreeBSD _) _) = Nothing
+
+-- | Ensures debootstrap is installed.
+--
+-- When necessary, falls back to installing debootstrap from source.
+-- Note that installation from source is done by downloading the tarball
+-- from a Debian mirror, with no cryptographic verification.
+installed :: RevertableProperty Linux Linux
+installed = install <!> remove
+ where
+ install = check (isJust <$> programPath) $
+ (aptinstall `pickOS` sourceInstall)
+ `describe` "debootstrap installed"
+
+ remove = (aptremove `pickOS` sourceRemove)
+ `describe` "debootstrap removed"
+
+ aptinstall = Apt.installed ["debootstrap"]
+ aptremove = Apt.removed ["debootstrap"]
+
+sourceInstall :: Property Linux
+sourceInstall = go
+ `requires` perlInstalled
+ `requires` arInstalled
+ where
+ go :: Property Linux
+ go = property "debootstrap installed from source" (liftIO sourceInstall')
+
+perlInstalled :: Property Linux
+perlInstalled = check (not <$> inPath "perl") $ property "perl installed" $
+ liftIO $ toResult . isJust <$> firstM id
+ [ yumInstall "perl"
+ ]
+
+arInstalled :: Property Linux
+arInstalled = check (not <$> inPath "ar") $ property "ar installed" $
+ liftIO $ toResult . isJust <$> firstM id
+ [ yumInstall "binutils"
+ ]
+
+yumInstall :: String -> IO Bool
+yumInstall p = boolSystem "yum" [Param "-y", Param "install", Param p]
+
+sourceInstall' :: IO Result
+sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
+ let indexfile = tmpd </> "index.html"
+ unlessM (download baseurl indexfile) $
+ errorMessage $ "Failed to download " ++ baseurl
+ urls <- sortBy (flip compare) -- highest version first
+ . filter ("debootstrap_" `isInfixOf`)
+ . filter (".tar." `isInfixOf`)
+ . extractUrls baseurl <$>
+ readFileStrictAnyEncoding indexfile
+ nukeFile indexfile
+
+ tarfile <- case urls of
+ (tarurl:_) -> do
+ let f = tmpd </> takeFileName tarurl
+ unlessM (download tarurl f) $
+ errorMessage $ "Failed to download " ++ tarurl
+ return f
+ _ -> errorMessage $ "Failed to find any debootstrap tarballs listed on " ++ baseurl
+
+ createDirectoryIfMissing True localInstallDir
+ bracket getWorkingDirectory changeWorkingDirectory $ \_ -> do
+ changeWorkingDirectory localInstallDir
+ unlessM (boolSystem "tar" [Param "xf", File tarfile]) $
+ errorMessage "Failed to extract debootstrap tar file"
+ nukeFile tarfile
+ l <- dirContents "."
+ case l of
+ (subdir:[]) -> do
+ changeWorkingDirectory subdir
+ makeDevicesTarball
+ makeWrapperScript (localInstallDir </> subdir)
+ return MadeChange
+ _ -> errorMessage "debootstrap tar file did not contain exactly one dirctory"
+
+sourceRemove :: Property Linux
+sourceRemove = property "debootstrap not installed from source" $ liftIO $
+ ifM (doesDirectoryExist sourceInstallDir)
+ ( do
+ removeDirectoryRecursive sourceInstallDir
+ return MadeChange
+ , return NoChange
+ )
+
+sourceInstallDir :: FilePath
+sourceInstallDir = "/usr/local/propellor/debootstrap"
+
+wrapperScript :: FilePath
+wrapperScript = sourceInstallDir </> "debootstrap.wrapper"
+
+-- | Finds debootstrap in PATH, but fall back to looking for the
+-- wrapper script that is installed, outside the PATH, when debootstrap
+-- is installed from source.
+programPath :: IO (Maybe FilePath)
+programPath = getM searchPath
+ [ "debootstrap"
+ , wrapperScript
+ ]
+
+makeWrapperScript :: FilePath -> IO ()
+makeWrapperScript dir = do
+ createDirectoryIfMissing True (takeDirectory wrapperScript)
+ writeFile wrapperScript $ unlines
+ [ "#!/bin/sh"
+ , "set -e"
+ , "DEBOOTSTRAP_DIR=" ++ dir
+ , "export DEBOOTSTRAP_DIR"
+ , dir </> "debootstrap" ++ " \"$@\""
+ ]
+ modifyFileMode wrapperScript (addModes $ readModes ++ executeModes)
+
+-- Work around for <http://bugs.debian.org/770217>
+makeDevicesTarball :: IO ()
+makeDevicesTarball = do
+ -- TODO append to tarball; avoid writing to /dev
+ writeFile foreignDevFlag "1"
+ ok <- boolSystem "sh" [Param "-c", Param tarcmd]
+ nukeFile foreignDevFlag
+ unless ok $
+ errorMessage "Failed to tar up /dev to generate devices.tar.gz"
+ where
+ tarcmd = "(cd / && tar cf - dev) | gzip > devices.tar.gz"
+
+fixForeignDev :: FilePath -> IO ()
+fixForeignDev target = whenM (doesFileExist (target ++ foreignDevFlag)) $ do
+ de <- standardPathEnv
+ void $ boolSystemEnv "chroot"
+ [ File target
+ , Param "sh"
+ , Param "-c"
+ , Param $ intercalate " && "
+ [ "apt-get update"
+ , "apt-get -y install makedev"
+ , "rm -rf /dev"
+ , "mkdir /dev"
+ , "cd /dev"
+ , "mount -t proc proc /proc"
+ , "/sbin/MAKEDEV std ptmx fd consoleonly"
+ ]
+ ]
+ (Just de)
+
+foreignDevFlag :: FilePath
+foreignDevFlag = "/dev/.propellor-foreign-dev"
+
+localInstallDir :: FilePath
+localInstallDir = "/usr/local/debootstrap"
+
+-- This http server directory listing is relied on to be fairly sane,
+-- which is one reason why it's using a specific server and not a
+-- round-robin address.
+baseurl :: Url
+baseurl = "http://ftp.debian.org/debian/pool/main/d/debootstrap/"
+
+download :: Url -> FilePath -> IO Bool
+download url dest = anyM id
+ [ boolSystem "curl" [Param "-o", File dest, Param url]
+ , boolSystem "wget" [Param "-O", File dest, Param url]
+ ]
+
+-- Pretty hackish, but I don't want to pull in a whole html parser
+-- or parsec dependency just for this.
+--
+-- To simplify parsing, lower case everything. This is ok because
+-- the filenames are all lower-case anyway.
+extractUrls :: Url -> String -> [Url]
+extractUrls base = collect [] . map toLower
+ where
+ collect l [] = l
+ collect l ('h':'r':'e':'f':'=':r) = case r of
+ ('"':r') -> findend l r'
+ _ -> findend l r
+ collect l (_:cs) = collect l cs
+
+ findend l s =
+ let (u, r) = break (== '"') s
+ u' = if "http" `isPrefixOf` u
+ then u
+ else base </> u
+ in collect (u':l) r
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
new file mode 100644
index 00000000..afeaa287
--- /dev/null
+++ b/src/Propellor/Property/DiskImage.hs
@@ -0,0 +1,346 @@
+-- | Disk image generation.
+--
+-- This module is designed to be imported unqualified.
+
+{-# LANGUAGE TypeFamilies #-}
+
+module Propellor.Property.DiskImage (
+ -- * Partition specification
+ module Propellor.Property.DiskImage.PartSpec,
+ -- * Properties
+ DiskImage,
+ imageBuilt,
+ imageRebuilt,
+ imageBuiltFrom,
+ imageExists,
+ -- * Finalization
+ Finalization,
+ grubBooted,
+ Grub.BIOS(..),
+ noFinalization,
+) where
+
+import Propellor.Base
+import Propellor.Property.DiskImage.PartSpec
+import Propellor.Property.Chroot (Chroot)
+import Propellor.Property.Chroot.Util (removeChroot)
+import qualified Propellor.Property.Chroot as Chroot
+import qualified Propellor.Property.Grub as Grub
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.Parted
+import Propellor.Property.Mount
+import Propellor.Property.Fstab (SwapPartition(..), genFstab)
+import Propellor.Property.Partition
+import Propellor.Property.Rsync
+import Propellor.Container
+import Utility.Path
+
+import Data.List (isPrefixOf, isInfixOf, sortBy)
+import Data.Function (on)
+import qualified Data.Map.Strict as M
+import qualified Data.ByteString.Lazy as L
+import System.Posix.Files
+
+type DiskImage = FilePath
+
+-- | Creates a bootable disk image.
+--
+-- First the specified Chroot is set up, and its properties are satisfied.
+--
+-- Then, the disk image is set up, and the chroot is copied into the
+-- appropriate partition(s) of it.
+--
+-- Example use:
+--
+-- > import Propellor.Property.DiskImage
+--
+-- > let chroot d = Chroot.debootstrapped mempty d
+-- > & osDebian Unstable "amd64"
+-- > & Apt.installed ["linux-image-amd64"]
+-- > & User.hasPassword (User "root")
+-- > & User.accountFor (User "demo")
+-- > & User.hasPassword (User "demo")
+-- > & User.hasDesktopGroups (User "demo")
+-- > & ...
+-- > in imageBuilt "/srv/images/foo.img" chroot
+-- > MSDOS (grubBooted PC)
+-- > [ partition EXT2 `mountedAt` "/boot"
+-- > `setFlag` BootFlag
+-- > , partition EXT4 `mountedAt` "/"
+-- > `addFreeSpace` MegaBytes 100
+-- > `mountOpt` errorReadonly
+-- > , swapPartition (MegaBytes 256)
+-- > ]
+--
+-- Note that the disk image file is reused if it already exists,
+-- to avoid expensive IO to generate a new one. And, it's updated in-place,
+-- so its contents are undefined during the build process.
+--
+-- Note that the `Chroot.noServices` property is automatically added to the
+-- chroot while the disk image is being built, which should prevent any
+-- daemons that are included from being started on the system that is
+-- building the disk image.
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageBuilt = imageBuilt' False
+
+-- | Like 'built', but the chroot is deleted and rebuilt from scratch each
+-- time. This is more expensive, but useful to ensure reproducible results
+-- when the properties of the chroot have been changed.
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageRebuilt = imageBuilt' True
+
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageBuilt' rebuild img mkchroot tabletype final partspec =
+ imageBuiltFrom img chrootdir tabletype final partspec
+ `requires` Chroot.provisioned chroot
+ `requires` (cleanrebuild <!> (doNothing :: Property UnixLike))
+ `describe` desc
+ where
+ desc = "built disk image " ++ img
+ cleanrebuild :: Property Linux
+ cleanrebuild
+ | rebuild = property desc $ do
+ liftIO $ removeChroot chrootdir
+ return MadeChange
+ | otherwise = doNothing
+ chrootdir = img ++ ".chroot"
+ chroot =
+ let c = mkchroot chrootdir
+ in setContainerProps c $ containerProps c
+ -- Before ensuring any other properties of the chroot,
+ -- avoid starting services. Reverted by imageFinalized.
+ &^ Chroot.noServices
+ -- First stage finalization.
+ & fst final
+ & cachesCleaned
+
+-- | This property is automatically added to the chroot when building a
+-- disk image. It cleans any caches of information that can be omitted;
+-- eg the apt cache on Debian.
+cachesCleaned :: Property UnixLike
+cachesCleaned = "cache cleaned" ==> (Apt.cacheCleaned `pickOS` skipit)
+ where
+ skipit = doNothing :: Property UnixLike
+
+-- | Builds a disk image from the contents of a chroot.
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) UnixLike
+imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
+ where
+ desc = img ++ " built from " ++ chrootdir
+ mkimg = property' desc $ \w -> do
+ -- unmount helper filesystems such as proc from the chroot
+ -- before getting sizes
+ liftIO $ unmountBelow chrootdir
+ szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize
+ <$> liftIO (dirSizes chrootdir)
+ let calcsz mnts = maybe defSz fudge . getMountSz szm mnts
+ -- tie the knot!
+ let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $
+ map (calcsz mnts) mnts
+ ensureProperty w $
+ imageExists img (partTableSize parttable)
+ `before`
+ partitioned YesReallyDeleteDiskContents img parttable
+ `before`
+ kpartx img (mkimg' mnts mntopts parttable)
+ mkimg' mnts mntopts parttable devs =
+ partitionsPopulated chrootdir mnts mntopts devs
+ `before`
+ imageFinalized final mnts mntopts devs parttable
+ rmimg = File.notPresent img
+
+partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
+partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
+ mconcat $ zipWith3 (go w) mnts mntopts devs
+ where
+ desc = "partitions populated from " ++ chrootdir
+
+ go _ Nothing _ _ = noChange
+ go w (Just mnt) mntopt loopdev = withTmpDir "mnt" $ \tmpdir -> bracket
+ (liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir mntopt)
+ (const $ liftIO $ umountLazy tmpdir)
+ $ \ismounted -> if ismounted
+ then ensureProperty w $
+ syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir
+ else return FailedChange
+
+ filtersfor mnt =
+ let childmnts = map (drop (length (dropTrailingPathSeparator mnt))) $
+ filter (\m -> m /= mnt && addTrailingPathSeparator mnt `isPrefixOf` m)
+ (catMaybes mnts)
+ in concatMap (\m ->
+ -- Include the child mount point, but exclude its contents.
+ [ Include (Pattern m)
+ , Exclude (filesUnder m)
+ -- Preserve any lost+found directory that mkfs made
+ , Protect (Pattern "lost+found")
+ ]) childmnts
+
+-- The constructor for each Partition is passed the size of the files
+-- from the chroot that will be put in that partition.
+fitChrootSize :: TableType -> [PartSpec] -> [PartSize] -> ([Maybe MountPoint], [MountOpts], PartTable)
+fitChrootSize tt l basesizes = (mounts, mountopts, parttable)
+ where
+ (mounts, mountopts, sizers) = unzip3 l
+ parttable = PartTable tt (zipWith id sizers basesizes)
+
+-- | Generates a map of the sizes of the contents of
+-- every directory in a filesystem tree.
+--
+-- (Hard links are counted multiple times for simplicity)
+--
+-- Should be same values as du -bl
+dirSizes :: FilePath -> IO (M.Map FilePath Integer)
+dirSizes top = go M.empty top [top]
+ where
+ go m _ [] = return m
+ go m dir (i:is) = flip catchIO (\_ioerr -> go m dir is) $ do
+ s <- getSymbolicLinkStatus i
+ let sz = fromIntegral (fileSize s)
+ if isDirectory s
+ then do
+ subm <- go M.empty i =<< dirContents i
+ let sz' = M.foldr' (+) sz
+ (M.filterWithKey (const . subdirof i) subm)
+ go (M.insertWith (+) i sz' (M.union m subm)) dir is
+ else go (M.insertWith (+) dir sz m) dir is
+ subdirof parent i = not (i `equalFilePath` parent) && takeDirectory i `equalFilePath` parent
+
+getMountSz :: (M.Map FilePath PartSize) -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize
+getMountSz _ _ Nothing = Nothing
+getMountSz szm l (Just mntpt) =
+ fmap (`reducePartSize` childsz) (M.lookup mntpt szm)
+ where
+ childsz = mconcat $ mapMaybe (getMountSz szm l) (filter (isChild mntpt) l)
+
+-- | Ensures that a disk image file of the specified size exists.
+--
+-- If the file doesn't exist, or is too small, creates a new one, full of 0's.
+--
+-- If the file is too large, truncates it down to the specified size.
+imageExists :: FilePath -> ByteSize -> Property Linux
+imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
+ ms <- catchMaybeIO $ getFileStatus img
+ case ms of
+ Just s
+ | toInteger (fileSize s) == toInteger sz -> return NoChange
+ | toInteger (fileSize s) > toInteger sz -> do
+ setFileSize img (fromInteger sz)
+ return MadeChange
+ _ -> do
+ L.writeFile img (L.replicate (fromIntegral sz) 0)
+ return MadeChange
+
+-- | A pair of properties. The first property is satisfied within the
+-- chroot, and is typically used to download the boot loader.
+--
+-- The second property is run after the disk image is created,
+-- with its populated partition tree mounted in the provided
+-- location from the provided loop devices. This will typically
+-- take care of installing the boot loader to the image.
+--
+-- It's ok if the second property leaves additional things mounted
+-- in the partition tree.
+type Finalization = (Property Linux, (FilePath -> [LoopDev] -> Property Linux))
+
+imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
+imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
+ property' "disk image finalized" $ \w ->
+ withTmpDir "mnt" $ \top ->
+ go w top `finally` liftIO (unmountall top)
+ where
+ go w top = do
+ liftIO $ mountall top
+ liftIO $ writefstab top
+ liftIO $ allowservices top
+ ensureProperty w $ final top devs
+
+ -- Ordered lexographically by mount point, so / comes before /usr
+ -- comes before /usr/local
+ orderedmntsdevs :: [(Maybe MountPoint, (MountOpts, LoopDev))]
+ orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts (zip mntopts devs)
+
+ swaps = map (SwapPartition . partitionLoopDev . snd) $
+ filter ((== LinuxSwap) . partFs . fst) $
+ zip parts devs
+
+ mountall top = forM_ orderedmntsdevs $ \(mp, (mopts, loopdev)) -> case mp of
+ Nothing -> noop
+ Just p -> do
+ let mnt = top ++ p
+ createDirectoryIfMissing True mnt
+ unlessM (mount "auto" (partitionLoopDev loopdev) mnt mopts) $
+ error $ "failed mounting " ++ mnt
+
+ unmountall top = do
+ unmountBelow top
+ umountLazy top
+
+ writefstab top = do
+ let fstab = top ++ "/etc/fstab"
+ old <- catchDefaultIO [] $ filter (not . unconfigured) . lines
+ <$> readFileStrict fstab
+ new <- genFstab (map (top ++) (catMaybes mnts))
+ swaps (toSysDir top)
+ writeFile fstab $ unlines $ new ++ old
+ -- Eg "UNCONFIGURED FSTAB FOR BASE SYSTEM"
+ unconfigured s = "UNCONFIGURED" `isInfixOf` s
+
+ allowservices top = nukeFile (top ++ "/usr/sbin/policy-rc.d")
+
+noFinalization :: Finalization
+noFinalization = (doNothing, \_ _ -> doNothing)
+
+-- | Makes grub be the boot loader of the disk image.
+grubBooted :: Grub.BIOS -> Finalization
+grubBooted bios = (Grub.installed' bios, boots)
+ where
+ boots mnt loopdevs = combineProperties "disk image boots using grub" $ props
+ -- bind mount host /dev so grub can access the loop devices
+ & bindMount "/dev" (inmnt "/dev")
+ & mounted "proc" "proc" (inmnt "/proc") mempty
+ & mounted "sysfs" "sys" (inmnt "/sys") mempty
+ -- update the initramfs so it gets the uuid of the root partition
+ & inchroot "update-initramfs" ["-u"]
+ `assume` MadeChange
+ -- work around for http://bugs.debian.org/802717
+ & check haveosprober (inchroot "chmod" ["-x", osprober])
+ & inchroot "update-grub" []
+ `assume` MadeChange
+ & check haveosprober (inchroot "chmod" ["+x", osprober])
+ & inchroot "grub-install" [wholediskloopdev]
+ `assume` MadeChange
+ -- sync all buffered changes out to the disk image
+ -- may not be necessary, but seemed needed sometimes
+ -- when using the disk image right away.
+ & cmdProperty "sync" []
+ `assume` NoChange
+ where
+ -- cannot use </> since the filepath is absolute
+ inmnt f = mnt ++ f
+
+ inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps)
+
+ haveosprober = doesFileExist (inmnt osprober)
+ osprober = "/etc/grub.d/30_os-prober"
+
+ -- It doesn't matter which loopdev we use; all
+ -- come from the same disk image, and it's the loop dev
+ -- for the whole disk image we seek.
+ wholediskloopdev = case loopdevs of
+ (l:_) -> wholeDiskLoopDev l
+ [] -> error "No loop devs provided!"
+
+isChild :: FilePath -> Maybe MountPoint -> Bool
+isChild mntpt (Just d)
+ | d `equalFilePath` mntpt = False
+ | otherwise = mntpt `dirContains` d
+isChild _ Nothing = False
+
+-- | From a location in a chroot (eg, /tmp/chroot/usr) to
+-- the corresponding location inside (eg, /usr).
+toSysDir :: FilePath -> FilePath -> FilePath
+toSysDir chrootdir d = case makeRelative chrootdir d of
+ "." -> "/"
+ sysdir -> "/" ++ sysdir
diff --git a/src/Propellor/Property/DiskImage/PartSpec.hs b/src/Propellor/Property/DiskImage/PartSpec.hs
new file mode 100644
index 00000000..4b05df03
--- /dev/null
+++ b/src/Propellor/Property/DiskImage/PartSpec.hs
@@ -0,0 +1,81 @@
+-- | Disk image partition specification and combinators.
+
+module Propellor.Property.DiskImage.PartSpec (
+ module Propellor.Property.DiskImage.PartSpec,
+ Partition,
+ PartSize(..),
+ PartFlag(..),
+ TableType(..),
+ Fs(..),
+ MountPoint,
+) where
+
+import Propellor.Base
+import Propellor.Property.Parted
+import Propellor.Property.Mount
+
+-- | Specifies a mount point, mount options, and a constructor for a Partition.
+--
+-- The size that is eventually provided is the amount of space needed to
+-- hold the files that appear in the directory where the partition is to be
+-- mounted. Plus a fudge factor, since filesystems have some space
+-- overhead.
+type PartSpec = (Maybe MountPoint, MountOpts, PartSize -> Partition)
+
+-- | Partitions that are not to be mounted (ie, LinuxSwap), or that have
+-- no corresponding directory in the chroot will have 128 MegaBytes
+-- provided as a default size.
+defSz :: PartSize
+defSz = MegaBytes 128
+
+-- | Add 2% for filesystem overhead. Rationalle for picking 2%:
+-- A filesystem with 1% overhead might just sneak by as acceptable.
+-- Double that just in case. Add an additional 3 mb to deal with
+-- non-scaling overhead of filesystems (eg, superblocks).
+-- Add an additional 200 mb for temp files, journals, etc.
+fudge :: PartSize -> PartSize
+fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200)
+
+-- | Specifies a swap partition of a given size.
+swapPartition :: PartSize -> PartSpec
+swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz))
+
+-- | Specifies a partition with a given filesystem.
+--
+-- The partition is not mounted anywhere by default; use the combinators
+-- below to configure it.
+partition :: Fs -> PartSpec
+partition fs = (Nothing, mempty, mkPartition fs)
+
+-- | Specifies where to mount a partition.
+mountedAt :: PartSpec -> FilePath -> PartSpec
+mountedAt (_, o, p) mp = (Just mp, o, p)
+
+-- | Specifies a mount option, such as "noexec"
+mountOpt :: ToMountOpts o => PartSpec -> o -> PartSpec
+mountOpt (mp, o, p) o' = (mp, o <> toMountOpts o', p)
+
+-- | Mount option to make a partition be remounted readonly when there's an
+-- error accessing it.
+errorReadonly :: MountOpts
+errorReadonly = toMountOpts "errors=remount-ro"
+
+-- | Adds additional free space to the partition.
+addFreeSpace :: PartSpec -> PartSize -> PartSpec
+addFreeSpace (mp, o, p) freesz = (mp, o, \sz -> p (sz <> freesz))
+
+-- | Forced a partition to be a specific size, instead of scaling to the
+-- size needed for the files in the chroot.
+setSize :: PartSpec -> PartSize -> PartSpec
+setSize (mp, o, p) sz = (mp, o, const (p sz))
+
+-- | Sets a flag on the partition.
+setFlag :: PartSpec -> PartFlag -> PartSpec
+setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p }
+
+-- | Makes a MSDOS partition be Extended, rather than Primary.
+extended :: PartSpec -> PartSpec
+extended s = adjustp s $ \p -> p { partType = Extended }
+
+adjustp :: PartSpec -> (Partition -> Partition) -> PartSpec
+adjustp (mp, o, p) f = (mp, o, f . p)
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 135c765d..2e2710a6 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -1,6 +1,7 @@
module Propellor.Property.Dns (
module Propellor.Types.Dns,
primary,
+ signedPrimary,
secondary,
secondaryFor,
mkSOA,
@@ -12,19 +13,24 @@ module Propellor.Property.Dns (
genZone,
) where
-import Propellor
+import Propellor.Base
import Propellor.Types.Dns
-import Propellor.Property.File
import Propellor.Types.Info
+import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Service as Service
+import Propellor.Property.Scheduled
+import Propellor.Property.DnsSec
import Utility.Applicative
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
--- | Primary dns server for a domain.
+-- | Primary dns server for a domain, using bind.
+--
+-- Currently, this only configures bind to serve forward DNS, not reverse DNS.
--
-- Most of the content of the zone file is configured by setting properties
-- of hosts. For example,
@@ -36,6 +42,9 @@ import Data.List
-- Will cause that hostmame and its alias to appear in the zone file,
-- with the configured IP address.
--
+-- Also, if a host has a ssh public key configured, a SSHFP record will
+-- be automatically generated for it.
+--
-- The [(BindDomain, Record)] list can be used for additional records
-- that cannot be configured elsewhere. This often includes NS records,
-- TXT records and perhaps CNAMEs pointing at hosts that propellor does
@@ -51,34 +60,47 @@ import Data.List
--
-- In either case, the secondary dns server Host should have an ipv4 and/or
-- ipv6 property defined.
-primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
-primary hosts domain soa rs = RevertableProperty setup cleanup
+primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
+primary hosts domain soa rs = setup <!> cleanup
where
- setup = withwarnings (check needupdate baseprop)
- `requires` servingZones
+ setup = setupPrimary zonefile id hosts domain soa rs
`onChange` Service.reloaded "bind9"
- cleanup = check (doesFileExist zonefile) $
- property ("removed dns primary for " ++ domain)
- (makeChange $ removeZoneFile zonefile)
- `requires` namedConfWritten
- `onChange` Service.reloaded "bind9"
-
- (partialzone, zonewarnings) = genZone hosts domain soa
- zone = partialzone { zHosts = zHosts partialzone ++ rs }
+ cleanup = cleanupPrimary zonefile domain
+ `onChange` Service.reloaded "bind9"
+
zonefile = "/etc/bind/propellor/db." ++ domain
- baseprop = Property ("dns primary for " ++ domain)
- (makeChange $ writeZoneFile zone zonefile)
- (addNamedConf conf)
- withwarnings p = adjustProperty p $ \satisfy -> do
+
+setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property (HasInfo + DebianLike)
+setupPrimary zonefile mknamedconffile hosts domain soa rs =
+ withwarnings baseprop
+ `requires` servingZones
+ where
+ hostmap = hostMap hosts
+ -- Known hosts with hostname located in the domain.
+ indomain = M.elems $ M.filterWithKey (\hn _ -> inDomain domain $ AbsDomain $ hn) hostmap
+
+ (partialzone, zonewarnings) = genZone indomain hostmap domain soa
+ baseprop = primaryprop
+ `setInfoProperty` (toInfo (addNamedConf conf))
+ primaryprop :: Property DebianLike
+ primaryprop = property ("dns primary for " ++ domain) $ do
+ sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
+ let zone = partialzone
+ { zHosts = zHosts partialzone ++ rs ++ sshfps }
+ ifM (liftIO $ needupdate zone)
+ ( makeChange $ writeZoneFile zone zonefile
+ , noChange
+ )
+ withwarnings p = adjustPropertySatisfy p $ \a -> do
mapM_ warningMessage $ zonewarnings ++ secondarywarnings
- satisfy
+ a
conf = NamedConf
{ confDomain = domain
, confDnsServerType = Master
- , confFile = zonefile
+ , confFile = mknamedconffile zonefile
, confMasters = []
, confAllowTransfer = nub $
- concatMap (\h -> hostAddresses h hosts) $
+ concatMap (`hostAddresses` hosts) $
secondaries ++ nssecondaries
, confLines = []
}
@@ -88,7 +110,7 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
rootRecords = map snd $
filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
- needupdate = do
+ needupdate zone = do
v <- readZonePropellorFile zonefile
return $ case v of
Nothing -> True
@@ -98,6 +120,66 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
z = zone { zSOA = (zSOA zone) { sSerial = oldserial } }
in z /= oldzone || oldserial < sSerial (zSOA zone)
+
+cleanupPrimary :: FilePath -> Domain -> Property DebianLike
+cleanupPrimary zonefile domain = check (doesFileExist zonefile) $
+ go `requires` namedConfWritten
+ where
+ desc = "removed dns primary for " ++ domain
+ go :: Property DebianLike
+ go = property desc (makeChange $ removeZoneFile zonefile)
+
+-- | Primary dns server for a domain, secured with DNSSEC.
+--
+-- This is like `primary`, except the resulting zone
+-- file is signed.
+-- The Zone Signing Key (ZSK) and Key Signing Key (KSK)
+-- used in signing it are taken from the PrivData.
+--
+-- As a side effect of signing the zone, a
+-- </var/cache/bind/dsset-domain.>
+-- file will be created. This file contains the DS records
+-- which need to be communicated to your domain registrar
+-- to make DNSSEC be used for your domain. Doing so is outside
+-- the scope of propellor (currently). See for example the tutorial
+-- <https://www.digitalocean.com/community/tutorials/how-to-setup-dnssec-on-an-authoritative-bind-dns-server--2>
+--
+-- The 'Recurrance' controls how frequently the signature
+-- should be regenerated, using a new random salt, to prevent
+-- zone walking attacks. `Weekly Nothing` is a reasonable choice.
+--
+-- To transition from 'primary' to 'signedPrimary', you can revert
+-- the 'primary' property, and add this property.
+--
+-- Note that DNSSEC zone files use a serial number based on the unix epoch.
+-- This is different from the serial number used by 'primary', so if you
+-- want to later disable DNSSEC you will need to adjust the serial number
+-- passed to mkSOA to ensure it is larger.
+signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
+signedPrimary recurrance hosts domain soa rs = setup <!> cleanup
+ where
+ setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
+ (props
+ & setupPrimary zonefile signedZoneFile hosts domain soa rs'
+ & zoneSigned domain zonefile
+ & forceZoneSigned domain zonefile `period` recurrance
+ )
+ `onChange` Service.reloaded "bind9"
+
+ cleanup = cleanupPrimary zonefile domain
+ `onChange` revert (zoneSigned domain zonefile)
+ `onChange` Service.reloaded "bind9"
+
+ -- Include the public keys into the zone file.
+ rs' = include PubKSK : include PubZSK : rs
+ include k = (RootDomain, INCLUDE (keyFn domain k))
+
+ -- Put DNSSEC zone files in a different directory than is used for
+ -- the regular ones. This allows 'primary' to be reverted and
+ -- 'signedPrimary' enabled, without the reverted property stomping
+ -- on the new one's settings.
+ zonefile = "/etc/bind/propellor/dnssec/db." ++ domain
+
-- | Secondary dns server for a domain.
--
-- The primary server is determined by looking at the properties of other
@@ -105,13 +187,13 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
--
-- Note that if a host is declared to be a primary and a secondary dns
-- server for the same domain, the primary server config always wins.
-secondary :: [Host] -> Domain -> RevertableProperty
+secondary :: [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike
secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
-- | This variant is useful if the primary server does not have its DNS
-- configured via propellor.
-secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty
-secondaryFor masters hosts domain = RevertableProperty setup cleanup
+secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike
+secondaryFor masters hosts domain = setup <!> cleanup
where
setup = pureInfoProperty desc (addNamedConf conf)
`requires` servingZones
@@ -122,7 +204,7 @@ secondaryFor masters hosts domain = RevertableProperty setup cleanup
{ confDomain = domain
, confDnsServerType = Secondary
, confFile = "db." ++ domain
- , confMasters = concatMap (\m -> hostAddresses m hosts) masters
+ , confMasters = concatMap (`hostAddresses` hosts) masters
, confAllowTransfer = []
, confLines = []
}
@@ -131,7 +213,7 @@ otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
otherServers wantedtype hosts domain =
M.keys $ M.filter wanted $ hostMap hosts
where
- wanted h = case M.lookup domain (fromNamedConfMap $ _namedconf $ hostInfo h) of
+ wanted h = case M.lookup domain (fromNamedConfMap $ fromInfo $ hostInfo h) of
Nothing -> False
Just conf -> confDnsServerType conf == wantedtype
&& confDomain conf == domain
@@ -139,15 +221,15 @@ otherServers wantedtype hosts domain =
-- | Rewrites the whole named.conf.local file to serve the zones
-- configured by `primary` and `secondary`, and ensures that bind9 is
-- running.
-servingZones :: Property
+servingZones :: Property DebianLike
servingZones = namedConfWritten
`onChange` Service.reloaded "bind9"
`requires` Apt.serviceInstalledRunning "bind9"
-namedConfWritten :: Property
-namedConfWritten = property "named.conf configured" $ do
+namedConfWritten :: Property DebianLike
+namedConfWritten = property' "named.conf configured" $ \w -> do
zs <- getNamedConf
- ensureProperty $
+ ensureProperty w $
hasContent namedConfFile $
concatMap confStanza $ M.elems zs
@@ -166,7 +248,7 @@ confStanza c =
]
where
cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
- ipblock name l =
+ ipblock name l =
[ "\t" ++ name ++ " {" ] ++
(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++
[ "\t};" ]
@@ -209,30 +291,40 @@ dValue (RelDomain d) = d
dValue (AbsDomain d) = d ++ "."
dValue (RootDomain) = "@"
-rField :: Record -> String
-rField (Address (IPv4 _)) = "A"
-rField (Address (IPv6 _)) = "AAAA"
-rField (CNAME _) = "CNAME"
-rField (MX _ _) = "MX"
-rField (NS _) = "NS"
-rField (TXT _) = "TXT"
-rField (SRV _ _ _ _) = "SRV"
-
-rValue :: Record -> String
-rValue (Address (IPv4 addr)) = addr
-rValue (Address (IPv6 addr)) = addr
-rValue (CNAME d) = dValue d
-rValue (MX pri d) = show pri ++ " " ++ dValue d
-rValue (NS d) = dValue d
-rValue (SRV priority weight port target) = unwords
+rField :: Record -> Maybe String
+rField (Address (IPv4 _)) = Just "A"
+rField (Address (IPv6 _)) = Just "AAAA"
+rField (CNAME _) = Just "CNAME"
+rField (MX _ _) = Just "MX"
+rField (NS _) = Just "NS"
+rField (TXT _) = Just "TXT"
+rField (SRV _ _ _ _) = Just "SRV"
+rField (SSHFP _ _ _) = Just "SSHFP"
+rField (INCLUDE _) = Just "$INCLUDE"
+rField (PTR _) = Nothing
+
+rValue :: Record -> Maybe String
+rValue (Address (IPv4 addr)) = Just addr
+rValue (Address (IPv6 addr)) = Just addr
+rValue (CNAME d) = Just $ dValue d
+rValue (MX pri d) = Just $ show pri ++ " " ++ dValue d
+rValue (NS d) = Just $ dValue d
+rValue (SRV priority weight port target) = Just $ unwords
[ show priority
, show weight
, show port
, dValue target
]
-rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
+rValue (SSHFP x y s) = Just $ unwords
+ [ show x
+ , show y
+ , s
+ ]
+rValue (INCLUDE f) = Just f
+rValue (TXT s) = Just $ [q] ++ filter (/= q) s ++ [q]
where
q = '"'
+rValue (PTR _) = Nothing
-- | Adjusts the serial number of the zone to always be larger
-- than the serial number in the Zone record,
@@ -290,23 +382,28 @@ readZonePropellorFile f = catchDefaultIO Nothing $
-- | Generating a zone file.
genZoneFile :: Zone -> String
genZoneFile (Zone zdomain soa rs) = unlines $
- header : genSOA soa ++ map (genRecord zdomain) rs
+ header : genSOA soa ++ mapMaybe (genRecord zdomain) rs
where
header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
-genRecord :: Domain -> (BindDomain, Record) -> String
-genRecord zdomain (domain, record) = intercalate "\t"
- [ domainHost zdomain domain
- , "IN"
- , rField record
- , rValue record
- ]
+genRecord :: Domain -> (BindDomain, Record) -> Maybe String
+genRecord zdomain (domain, record) = case (rField record, rValue record) of
+ (Nothing, _) -> Nothing
+ (_, Nothing) -> Nothing
+ (Just rfield, Just rvalue) -> Just $ intercalate "\t" $ case record of
+ INCLUDE _ -> [ rfield, rvalue ]
+ _ ->
+ [ domainHost zdomain domain
+ , "IN"
+ , rfield
+ , rvalue
+ ]
genSOA :: SOA -> [String]
-genSOA soa =
+genSOA soa =
-- "@ IN SOA ns1.example.com. root ("
[ intercalate "\t"
- [ dValue RootDomain
+ [ dValue RootDomain
, "IN"
, "SOA"
, dValue (sDomain soa)
@@ -332,19 +429,17 @@ type WarningMessage = String
-- | Generates a Zone for a particular Domain from the DNS properies of all
-- hosts that propellor knows about that are in that Domain.
-genZone :: [Host] -> Domain -> SOA -> (Zone, [WarningMessage])
-genZone hosts zdomain soa =
- let (warnings, zhosts) = partitionEithers $ concat $ map concat
+--
+-- Does not include SSHFP records.
+genZone :: [Host] -> M.Map HostName Host -> Domain -> SOA -> (Zone, [WarningMessage])
+genZone inzdomain hostmap zdomain soa =
+ let (warnings, zhosts) = partitionEithers $ concatMap concat
[ map hostips inzdomain
, map hostrecords inzdomain
- , map addcnames (M.elems m)
+ , map addcnames (M.elems hostmap)
]
in (Zone zdomain soa (simplify zhosts), warnings)
where
- m = hostMap hosts
- -- Known hosts with hostname located in the zone's domain.
- inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
-
-- Each host with a hostname located in the zdomain
-- should have 1 or more IPAddrs in its Info.
--
@@ -373,7 +468,7 @@ genZone hosts zdomain soa =
-- So we can just use the IPAddrs.
addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
addcnames h = concatMap gen $ filter (inDomain zdomain) $
- mapMaybe getCNAME $ S.toList (_dns info)
+ mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info
where
info = hostInfo h
gen c = case getAddresses info of
@@ -381,14 +476,14 @@ genZone hosts zdomain soa =
l -> map (ret . Address) l
where
ret record = Right (c, record)
-
+
-- Adds any other DNS records for a host located in the zdomain.
hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
hostrecords h = map Right l
where
info = hostInfo h
l = zip (repeat $ AbsDomain $ hostName h)
- (S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns info))
+ (S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (fromDnsInfo $ fromInfo info))
-- Simplifies the list of hosts. Remove duplicate entries.
-- Also, filter out any CHAMES where the same domain has an
@@ -417,10 +512,39 @@ domainHost base (AbsDomain d)
where
dotbase = '.':base
-addNamedConf :: NamedConf -> Info
-addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) }
+addNamedConf :: NamedConf -> NamedConfMap
+addNamedConf conf = NamedConfMap (M.singleton domain conf)
where
domain = confDomain conf
getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks $ fromNamedConfMap . _namedconf . hostInfo
+getNamedConf = asks $ fromNamedConfMap . fromInfo . hostInfo
+
+-- | Generates SSHFP records for hosts in the domain (or with CNAMES
+-- in the domain) that have configured ssh public keys.
+--
+-- This is done using ssh-keygen, so sadly needs IO.
+genSSHFP :: Domain -> Host -> Propellor [(BindDomain, Record)]
+genSSHFP domain h = concatMap mk . concat <$> (gen =<< get)
+ where
+ get = fromHost [h] hostname Ssh.getHostPubKey
+ gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty
+ mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing)
+ (AbsDomain hostname : cnames)
+ cnames = mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info
+ hostname = hostName h
+ info = hostInfo h
+
+genSSHFP' :: String -> IO [Record]
+genSSHFP' pubkey = withTmpFile "sshfp" $ \tmp tmph -> do
+ hPutStrLn tmph pubkey
+ hClose tmph
+ s <- catchDefaultIO "" $
+ readProcess "ssh-keygen" ["-r", "dummy", "-f", tmp]
+ return $ mapMaybe (parse . words) $ lines s
+ where
+ parse ("dummy":"IN":"SSHFP":x:y:s:[]) = do
+ x' <- readish x
+ y' <- readish y
+ return $ SSHFP x' y' s
+ parse _ = Nothing
diff --git a/src/Propellor/Property/DnsSec.hs b/src/Propellor/Property/DnsSec.hs
new file mode 100644
index 00000000..aa58dc60
--- /dev/null
+++ b/src/Propellor/Property/DnsSec.hs
@@ -0,0 +1,122 @@
+module Propellor.Property.DnsSec where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+
+-- | Puts the DNSSEC key files in place from PrivData.
+--
+-- signedPrimary uses this, so this property does not normally need to be
+-- used directly.
+keysInstalled :: Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
+keysInstalled domain = setup <!> cleanup
+ where
+ setup = propertyList "DNSSEC keys installed" $ toProps $
+ map installkey keys
+
+ cleanup = propertyList "DNSSEC keys removed" $ toProps $
+ map (File.notPresent . keyFn domain) keys
+
+ installkey k = writer (keysrc k) (keyFn domain k) (Context domain)
+ where
+ writer
+ | isPublic k = File.hasPrivContentExposedFrom
+ | otherwise = File.hasPrivContentFrom
+
+ keys = [ PubZSK, PrivZSK, PubKSK, PrivKSK ]
+
+ keysrc k = PrivDataSource (DnsSec k) $ unwords
+ [ "The file with extension"
+ , keyExt k
+ , "created by running:"
+ , if isZoneSigningKey k
+ then "dnssec-keygen -a RSASHA256 -b 2048 -n ZONE " ++ domain
+ else "dnssec-keygen -f KSK -a RSASHA256 -b 4096 -n ZONE " ++ domain
+ ]
+
+-- | Uses dnssec-signzone to sign a domain's zone file.
+--
+-- signedPrimary uses this, so this property does not normally need to be
+-- used directly.
+zoneSigned :: Domain -> FilePath -> RevertableProperty (HasInfo + UnixLike) UnixLike
+zoneSigned domain zonefile = setup <!> cleanup
+ where
+ setup :: Property (HasInfo + UnixLike)
+ setup = check needupdate (forceZoneSigned domain zonefile)
+ `requires` keysInstalled domain
+
+ cleanup :: Property UnixLike
+ cleanup = File.notPresent (signedZoneFile zonefile)
+ `before` File.notPresent dssetfile
+ `before` revert (keysInstalled domain)
+
+ dssetfile = dir </> "-" ++ domain ++ "."
+ dir = takeDirectory zonefile
+
+ -- Need to update the signed zone file if the zone file or
+ -- any of the keys have a newer timestamp.
+ needupdate = do
+ v <- catchMaybeIO $ getModificationTime (signedZoneFile zonefile)
+ case v of
+ Nothing -> return True
+ Just t1 -> anyM (newerthan t1) $
+ zonefile : map (keyFn domain) [minBound..maxBound]
+
+ newerthan t1 f = do
+ t2 <- getModificationTime f
+ return (t2 >= t1)
+
+forceZoneSigned :: Domain -> FilePath -> Property UnixLike
+forceZoneSigned domain zonefile = property ("zone signed for " ++ domain) $ liftIO $ do
+ salt <- take 16 <$> saltSha1
+ let p = proc "dnssec-signzone"
+ [ "-A"
+ , "-3", salt
+ -- The serial number needs to be increased each time the
+ -- zone is resigned, even if there are no other changes,
+ -- so that it will propagate to secondaries. So, use the
+ -- unixtime serial format.
+ , "-N", "unixtime"
+ , "-o", domain
+ , zonefile
+ -- the ordering of these key files does not matter
+ , keyFn domain PubZSK
+ , keyFn domain PubKSK
+ ]
+ -- Run in the same directory as the zonefile, so it will
+ -- write the dsset file there.
+ (_, _, _, h) <- createProcess $
+ p { cwd = Just (takeDirectory zonefile) }
+ ifM (checkSuccessProcess h)
+ ( return MadeChange
+ , return FailedChange
+ )
+
+saltSha1 :: IO String
+saltSha1 = readProcess "sh"
+ [ "-c"
+ , "head -c 1024 /dev/urandom | sha1sum | cut -d ' ' -f 1"
+ ]
+
+-- | The file used for a given key.
+keyFn :: Domain -> DnsSecKey -> FilePath
+keyFn domain k = "/etc/bind/propellor/dnssec" </> concat
+ [ "K" ++ domain ++ "."
+ , if isZoneSigningKey k then "ZSK" else "KSK"
+ , keyExt k
+ ]
+
+-- | These are the extensions that dnssec-keygen looks for.
+keyExt :: DnsSecKey -> String
+keyExt k
+ | isPublic k = ".key"
+ | otherwise = ".private"
+
+isPublic :: DnsSecKey -> Bool
+isPublic k = k `elem` [PubZSK, PubKSK]
+
+isZoneSigningKey :: DnsSecKey -> Bool
+isZoneSigningKey k = k `elem` [PubZSK, PrivZSK]
+
+-- | dnssec-signzone makes a .signed file
+signedZoneFile :: FilePath -> FilePath
+signedZoneFile zonefile = zonefile ++ ".signed"
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 5a7a0840..2ef97438 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-}
-- | Docker support for propellor
--
@@ -11,114 +11,146 @@ module Propellor.Property.Docker (
configured,
container,
docked,
+ imageBuilt,
+ imagePulled,
memoryLimited,
garbageCollected,
tweaked,
- Image,
+ Image(..),
+ latestImage,
ContainerName,
+ Container(..),
+ HasImage(..),
-- * Container configuration
dns,
hostname,
+ Publishable,
publish,
expose,
user,
+ Mountable,
volume,
volumes_from,
workdir,
memory,
cpuShares,
link,
+ environment,
ContainerAlias,
restartAlways,
restartOnFailure,
restartNever,
-- * Internal use
+ init,
chain,
) where
-import Propellor
-import Propellor.SimpleSh
+import Propellor.Base hiding (init)
+import Propellor.Types.Docker
+import Propellor.Types.Container
+import Propellor.Types.Core
+import Propellor.Types.CmdLine
import Propellor.Types.Info
+import Propellor.Container
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
-import qualified Propellor.Property.Docker.Shim as Shim
-import Utility.SafeCommand
+import qualified Propellor.Property.Cmd as Cmd
+import qualified Propellor.Shim as Shim
import Utility.Path
+import Utility.ThreadScheduler
import Control.Concurrent.Async hiding (link)
import System.Posix.Directory
import System.Posix.Process
-import Data.List
+import Prelude hiding (init)
+import Data.List hiding (init)
import Data.List.Utils
-import qualified Data.Set as S
+import qualified Data.Map as M
+import System.Console.Concurrent
-installed :: Property
+installed :: Property DebianLike
installed = Apt.installed ["docker.io"]
-- | Configures docker with an authentication file, so that images can be
-- pushed to index.docker.io. Optional.
-configured :: Property
+configured :: Property (HasInfo + DebianLike)
configured = prop `requires` installed
where
- prop = withPrivData DockerAuthentication anyContext $ \getcfg ->
- property "docker configured" $ getcfg $ \cfg -> ensureProperty $
- "/root/.dockercfg" `File.hasContent` (lines cfg)
+ prop :: Property (HasInfo + DebianLike)
+ prop = withPrivData src anyContext $ \getcfg ->
+ property' "docker configured" $ \w -> getcfg $ \cfg -> ensureProperty w $
+ "/root/.dockercfg" `File.hasContent` privDataLines cfg
+ src = PrivDataSourceFileFromCommand DockerAuthentication
+ "/root/.dockercfg" "docker login"
-- | A short descriptive name for a container.
-- Should not contain whitespace or other unusual characters,
-- only [a-zA-Z0-9_-] are allowed
type ContainerName = String
--- | Starts accumulating the properties of a Docker container.
+-- | A docker container.
+data Container = Container Image Host
+
+instance IsContainer Container where
+ containerProperties (Container _ h) = containerProperties h
+ containerInfo (Container _ h) = containerInfo h
+ setContainerProperties (Container i h) ps = Container i (setContainerProperties h ps)
+
+class HasImage a where
+ getImageName :: a -> Image
+
+instance HasImage Image where
+ getImageName = id
+
+instance HasImage Container where
+ getImageName (Container i _) = i
+
+-- | Defines a Container with a given name, image, and properties.
+-- Add properties to configure the Container.
--
--- > container "web-server" "debian"
+-- > container "web-server" (latestImage "debian") $ props
-- > & publish "80:80"
-- > & Apt.installed {"apache2"]
-- > & ...
-container :: ContainerName -> Image -> Host
-container cn image = Host hn [] info
+container :: ContainerName -> Image -> Props metatypes -> Container
+container cn image (Props ps) = Container image (Host cn ps info)
where
- info = dockerInfo $ mempty { _dockerImage = Val image }
- hn = cn2hn cn
-
-cn2hn :: ContainerName -> HostName
-cn2hn cn = cn ++ ".docker"
+ info = dockerInfo mempty <> mconcat (map getInfoRecursive ps)
--- | Ensures that a docker container is set up and running, finding
--- its configuration in the passed list of hosts.
---
+-- | Ensures that a docker container is set up and running.
+--
-- The container has its own Properties which are handled by running
-- propellor inside the container.
--
-- When the container's Properties include DNS info, such as a CNAME,
--- that is propigated to the Info of the host(s) it's docked in.
+-- that is propagated to the Info of the Host it's docked in.
--
-- Reverting this property ensures that the container is stopped and
-- removed.
-docked
- :: [Host]
- -> ContainerName
- -> RevertableProperty
-docked hosts cn = RevertableProperty
- ((maybe id propigateInfo mhost) (go "docked" setup))
+docked :: Container -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
+docked ctr@(Container _ h) =
+ (propagateContainerInfo ctr (go "docked" setup))
+ <!>
(go "undocked" teardown)
where
- go desc a = property (desc ++ " " ++ cn) $ do
+ cn = hostName h
+
+ go desc a = property' (desc ++ " " ++ cn) $ \w -> do
hn <- asks hostName
let cid = ContainerId hn cn
- ensureProperties [findContainer mhost cid cn $ a cid]
-
- mhost = findHostNoAlias hosts (cn2hn cn)
+ ensureProperty w $ a cid (mkContainerInfo cid ctr)
- setup cid (Container image runparams) =
+ setup :: ContainerId -> ContainerInfo -> Property Linux
+ setup cid (ContainerInfo image runparams) =
provisionContainer cid
`requires`
runningContainer cid image runparams
`requires`
installed
- teardown cid (Container image _runparams) =
- combineProperties ("undocked " ++ fromContainerId cid)
+ teardown :: ContainerId -> ContainerInfo -> Property Linux
+ teardown cid (ContainerInfo image _runparams) =
+ combineProperties ("undocked " ++ fromContainerId cid) $ toProps
[ stoppedContainer cid
, property ("cleaned up " ++ fromContainerId cid) $
liftIO $ report <$> mapM id
@@ -127,35 +159,45 @@ docked hosts cn = RevertableProperty
]
]
-propigateInfo :: Host -> Property -> Property
-propigateInfo (Host _ _ containerinfo) p =
- combineProperties (propertyDesc p) $ p : dnsprops ++ privprops
+-- | Build the image from a directory containing a Dockerfile.
+imageBuilt :: HasImage c => FilePath -> c -> Property Linux
+imageBuilt directory ctr = built `describe` msg
where
- dnsprops = map addDNS (S.toList $ _dns containerinfo)
- privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo)
-
-findContainer
- :: Maybe Host
- -> ContainerId
- -> ContainerName
- -> (Container -> Property)
- -> Property
-findContainer mhost cid cn mk = case mhost of
- Nothing -> cantfind
- Just h -> maybe cantfind mk (mkContainer cid h)
+ msg = "docker image " ++ (imageIdentifier image) ++ " built from " ++ directory
+ built :: Property Linux
+ built = tightenTargets $
+ Cmd.cmdProperty' dockercmd ["build", "--tag", imageIdentifier image, "./"] workDir
+ `assume` MadeChange
+ workDir p = p { cwd = Just directory }
+ image = getImageName ctr
+
+-- | Pull the image from the standard Docker Hub registry.
+imagePulled :: HasImage c => c -> Property Linux
+imagePulled ctr = pulled `describe` msg
where
- cantfind = containerDesc cid $ property "" $ do
- liftIO $ warningMessage $
- "missing definition for docker container \"" ++ cn2hn cn
- return FailedChange
+ msg = "docker image " ++ (imageIdentifier image) ++ " pulled"
+ pulled :: Property Linux
+ pulled = tightenTargets $
+ Cmd.cmdProperty dockercmd ["pull", imageIdentifier image]
+ `assume` MadeChange
+ image = getImageName ctr
+
+propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
+propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
+ p `addInfoProperty` dockerinfo
+ where
+ dockerinfo = dockerInfo $
+ mempty { _dockerContainers = M.singleton cn h }
+ cn = hostName h
-mkContainer :: ContainerId -> Host -> Maybe Container
-mkContainer cid@(ContainerId hn _cn) h = Container
- <$> fromVal (_dockerImage info)
- <*> pure (map (\mkparam -> mkparam hn) (_dockerRunParams info))
+mkContainerInfo :: ContainerId -> Container -> ContainerInfo
+mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
+ ContainerInfo img runparams
where
- info = _dockerinfo $ hostInfo h'
- h' = h
+ runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
+ (_dockerRunParams info)
+ info = fromInfo $ hostInfo h'
+ h' = setContainerProps h $ containerProps h
-- Restart by default so container comes up on
-- boot or when docker is upgraded.
&^ restartAlways
@@ -172,88 +214,156 @@ mkContainer cid@(ContainerId hn _cn) h = Container
-- that were not set up using propellor.
--
-- Generally, should come after the properties for the desired containers.
-garbageCollected :: Property
-garbageCollected = propertyList "docker garbage collected"
- [ gccontainers
- , gcimages
- ]
+garbageCollected :: Property Linux
+garbageCollected = propertyList "docker garbage collected" $ props
+ & gccontainers
+ & gcimages
where
+ gccontainers :: Property Linux
gccontainers = property "docker containers garbage collected" $
liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
- gcimages = property "docker images garbage collected" $ do
+ gcimages :: Property Linux
+ gcimages = property "docker images garbage collected" $
liftIO $ report <$> (mapM removeImage =<< listImages)
-- | Tweaks a container to work well with docker.
--
-- Currently, this consists of making pam_loginuid lines optional in
--- the pam config, to work around https://github.com/docker/docker/issues/5663
+-- the pam config, to work around <https://github.com/docker/docker/issues/5663>
-- which affects docker 1.2.0.
-tweaked :: Property
-tweaked = trivial $
- cmdProperty "sh" ["-c", "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*"]
+tweaked :: Property Linux
+tweaked = tightenTargets $ cmdProperty "sh"
+ [ "-c"
+ , "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*"
+ ]
+ `assume` NoChange
`describe` "tweaked for docker"
--- | Configures the kernel to respect docker memory limits.
+-- | Configures the kernel to respect docker memory limits.
--
-- This assumes the system boots using grub 2. And that you don't need any
-- other GRUB_CMDLINE_LINUX_DEFAULT settings.
--
-- Only takes effect after reboot. (Not automated.)
-memoryLimited :: Property
-memoryLimited = "/etc/default/grub" `File.containsLine` cfg
- `describe` "docker memory limited"
- `onChange` cmdProperty "update-grub" []
+memoryLimited :: Property DebianLike
+memoryLimited = tightenTargets $
+ "/etc/default/grub" `File.containsLine` cfg
+ `describe` "docker memory limited"
+ `onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
where
cmdline = "cgroup_enable=memory swapaccount=1"
cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""++cmdline++"\""
-data Container = Container Image [RunParam]
+data ContainerInfo = ContainerInfo Image [RunParam]
-- | Parameters to pass to `docker run` when creating a container.
type RunParam = String
--- | A docker image, that can be used to run a container.
-type Image = String
+-- | ImageID is an image identifier to perform action on images. An
+-- ImageID can be the name of an container image, a UID, etc.
+--
+-- It just encapsulates a String to avoid the definition of a String
+-- instance of ImageIdentifier.
+newtype ImageID = ImageID String
+
+-- | Used to perform Docker action on an image.
+--
+-- Minimal complete definition: `imageIdentifier`
+class ImageIdentifier i where
+ -- | For internal purposes only.
+ toImageID :: i -> ImageID
+ toImageID = ImageID . imageIdentifier
+ -- | A string that Docker can use as an image identifier.
+ imageIdentifier :: i -> String
+
+instance ImageIdentifier ImageID where
+ imageIdentifier (ImageID i) = i
+ toImageID = id
+
+-- | A docker image, that can be used to run a container. The user has
+-- to specify a name and can provide an optional tag.
+-- See <http://docs.docker.com/userguide/dockerimages/ Docker Image Documention>
+-- for more information.
+data Image = Image
+ { repository :: String
+ , tag :: Maybe String
+ }
+ deriving (Eq, Read, Show)
+
+-- | Defines a Docker image without any tag. This is considered by
+-- Docker as the latest image of the provided repository.
+latestImage :: String -> Image
+latestImage repo = Image repo Nothing
+
+instance ImageIdentifier Image where
+ -- | The format of the imageIdentifier of an `Image` is:
+ -- repository | repository:tag
+ imageIdentifier i = repository i ++ (maybe "" ((++) ":") $ tag i)
+
+-- | The UID of an image. This UID is generated by Docker.
+newtype ImageUID = ImageUID String
+
+instance ImageIdentifier ImageUID where
+ imageIdentifier (ImageUID uid) = uid
-- | Set custom dns server for container.
-dns :: String -> Property
+dns :: String -> Property (HasInfo + Linux)
dns = runProp "dns"
-- | Set container host name.
-hostname :: String -> Property
+hostname :: String -> Property (HasInfo + Linux)
hostname = runProp "hostname"
-- | Set name of container.
-name :: String -> Property
+name :: String -> Property (HasInfo + Linux)
name = runProp "name"
+class Publishable p where
+ toPublish :: p -> String
+
+instance Publishable (Bound Port) where
+ toPublish p = fromPort (hostSide p) ++ ":" ++ fromPort (containerSide p)
+
+-- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort
+instance Publishable String where
+ toPublish = id
+
-- | Publish a container's port to the host
--- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
-publish :: String -> Property
-publish = runProp "publish"
+publish :: Publishable p => p -> Property (HasInfo + Linux)
+publish = runProp "publish" . toPublish
-- | Expose a container's port without publishing it.
-expose :: String -> Property
+expose :: String -> Property (HasInfo + Linux)
expose = runProp "expose"
-- | Username or UID for container.
-user :: String -> Property
+user :: String -> Property (HasInfo + Linux)
user = runProp "user"
--- | Mount a volume
--- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]
+class Mountable p where
+ toMount :: p -> String
+
+instance Mountable (Bound FilePath) where
+ toMount p = hostSide p ++ ":" ++ containerSide p
+
+-- | string format: [host-dir]:[container-dir]:[rw|ro]
+--
-- With just a directory, creates a volume in the container.
-volume :: String -> Property
-volume = runProp "volume"
+instance Mountable String where
+ toMount = id
+
+-- | Mount a volume
+volume :: Mountable v => v -> Property (HasInfo + Linux)
+volume = runProp "volume" . toMount
-- | Mount a volume from the specified container into the current
-- container.
-volumes_from :: ContainerName -> Property
+volumes_from :: ContainerName -> Property (HasInfo + Linux)
volumes_from cn = genProp "volumes-from" $ \hn ->
fromContainerId (ContainerId hn cn)
--- | Work dir inside the container.
-workdir :: String -> Property
+-- | Work dir inside the container.
+workdir :: String -> Property (HasInfo + Linux)
workdir = runProp "workdir"
-- | Memory limit for container.
@@ -261,18 +371,18 @@ workdir = runProp "workdir"
--
-- Note: Only takes effect when the host has the memoryLimited property
-- enabled.
-memory :: String -> Property
+memory :: String -> Property (HasInfo + Linux)
memory = runProp "memory"
-- | CPU shares (relative weight).
--
-- By default, all containers run at the same priority, but you can tell
-- the kernel to give more CPU time to a container using this property.
-cpuShares :: Int -> Property
+cpuShares :: Int -> Property (HasInfo + Linux)
cpuShares = runProp "cpu-shares" . show
-- | Link with another container on the same host.
-link :: ContainerName -> ContainerAlias -> Property
+link :: ContainerName -> ContainerAlias -> Property (HasInfo + Linux)
link linkwith calias = genProp "link" $ \hn ->
fromContainerId (ContainerId hn linkwith) ++ ":" ++ calias
@@ -284,24 +394,32 @@ type ContainerAlias = String
-- propellor; as well as keeping badly behaved containers running,
-- it ensures that containers get started back up after reboot or
-- after docker is upgraded.
-restartAlways :: Property
+restartAlways :: Property (HasInfo + Linux)
restartAlways = runProp "restart" "always"
-- | Docker will restart the container if it exits nonzero.
-- If a number is provided, it will be restarted only up to that many
-- times.
-restartOnFailure :: Maybe Int -> Property
+restartOnFailure :: Maybe Int -> Property (HasInfo + Linux)
restartOnFailure Nothing = runProp "restart" "on-failure"
restartOnFailure (Just n) = runProp "restart" ("on-failure:" ++ show n)
-- | Makes docker not restart a container when it exits
-- Note that this includes not restarting it on boot!
-restartNever :: Property
+restartNever :: Property (HasInfo + Linux)
restartNever = runProp "restart" "no"
+-- | Set environment variable with a tuple composed by the environment
+-- variable name and its value.
+environment :: (String, String) -> Property (HasInfo + Linux)
+environment (k, v) = runProp "env" $ k ++ "=" ++ v
+
-- | A container is identified by its name, and the host
-- on which it's deployed.
-data ContainerId = ContainerId HostName ContainerName
+data ContainerId = ContainerId
+ { containerHostName :: HostName
+ , containerName :: ContainerName
+ }
deriving (Eq, Read, Show)
-- | Two containers with the same ContainerIdent were started from
@@ -324,22 +442,19 @@ toContainerId s
fromContainerId :: ContainerId -> String
fromContainerId (ContainerId hn cn) = cn++"."++hn++myContainerSuffix
-containerHostName :: ContainerId -> HostName
-containerHostName (ContainerId _ cn) = cn2hn cn
-
myContainerSuffix :: String
myContainerSuffix = ".propellor"
-containerDesc :: ContainerId -> Property -> Property
+containerDesc :: (IsProp (Property i)) => ContainerId -> Property i -> Property i
containerDesc cid p = p `describe` desc
where
- desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p
+ desc = "container " ++ fromContainerId cid ++ " " ++ getDesc p
-runningContainer :: ContainerId -> Image -> [RunParam] -> Property
+runningContainer :: ContainerId -> Image -> [RunParam] -> Property Linux
runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
l <- liftIO $ listContainers RunningContainers
if cid `elem` l
- then checkident =<< liftIO (getrunningident simpleShClient)
+ then checkident =<< liftIO getrunningident
else ifM (liftIO $ elem cid <$> listContainers AllContainers)
( do
-- The container exists, but is not
@@ -348,9 +463,9 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
-- starting it up first.
void $ liftIO $ startContainer cid
-- It can take a while for the container to
- -- start up enough to get its ident, so
- -- retry for up to 60 seconds.
- checkident =<< liftIO (getrunningident (simpleShClientRetry 60))
+ -- start up enough for its ident file to be
+ -- written, so retry for up to 60 seconds.
+ checkident =<< liftIO (retry 60 $ getrunningident)
, go image
)
where
@@ -359,33 +474,55 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
-- Check if the ident has changed; if so the
-- parameters of the container differ and it must
-- be restarted.
- checkident runningident
+ checkident (Right runningident)
| runningident == Just ident = noChange
| otherwise = do
void $ liftIO $ stopContainer cid
restartcontainer
+ checkident (Left errmsg) = do
+ warningMessage errmsg
+ return FailedChange
restartcontainer = do
- oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
+ oldimage <- liftIO $
+ maybe (toImageID image) toImageID <$> commitContainer cid
void $ liftIO $ removeContainer cid
go oldimage
- getrunningident shclient = shclient (namedPipe cid) "cat" [propellorIdent] $ \rs -> do
- let !v = extractident rs
- return v
-
- extractident :: [Resp] -> Maybe ContainerIdent
- extractident = headMaybe . catMaybes . map readish . catMaybes . map getStdout
+ getrunningident = withTmpFile "dockerrunsane" $ \t h -> do
+ -- detect #774376 which caused docker exec to not enter
+ -- the container namespace, and be able to access files
+ -- outside
+ hClose h
+ void . checkSuccessProcess . processHandle =<<
+ createProcess (inContainerProcess cid []
+ ["rm", "-f", t])
+ ifM (doesFileExist t)
+ ( Right . readish <$>
+ readProcess' (inContainerProcess cid []
+ ["cat", propellorIdent])
+ , return $ Left "docker exec failed to enter chroot properly (maybe an old kernel version?)"
+ )
- go img = do
- liftIO $ do
- clearProvisionedFlag cid
- createDirectoryIfMissing True (takeDirectory $ identFile cid)
- shim <- liftIO $ Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
- liftIO $ writeFile (identFile cid) (show ident)
- ensureProperty $ boolProperty "run" $ runContainer img
+ retry :: Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
+ retry 0 _ = return (Right Nothing)
+ retry n a = do
+ v <- a
+ case v of
+ Right Nothing -> do
+ threadDelaySeconds (Seconds 1)
+ retry (n-1) a
+ _ -> return v
+
+ go :: ImageIdentifier i => i -> Propellor Result
+ go img = liftIO $ do
+ clearProvisionedFlag cid
+ createDirectoryIfMissing True (takeDirectory $ identFile cid)
+ shim <- Shim.setup (localdir </> "propellor") Nothing (localdir </> shimdir cid)
+ writeFile (identFile cid) (show ident)
+ toResult <$> runContainer img
(runps ++ ["-i", "-d", "-t"])
- [shim, "--docker", fromContainerId cid]
+ [shim, "--continue", show (DockerInit (fromContainerId cid))]
-- | Called when propellor is running inside a docker container.
-- The string should be the container's ContainerId.
@@ -393,7 +530,6 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
-- This process is effectively init inside the container.
-- It even needs to wait on zombie processes!
--
--- Fork a thread to run the SimpleSh server in the background.
-- In the foreground, run an interactive bash (or sh) shell,
-- so that the user can interact with it when attached to the container.
--
@@ -401,26 +537,24 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
-- again. So, to make the necessary services get started on boot, this needs
-- to provision the container then. However, if the container is already
-- being provisioned by the calling propellor, it would be redundant and
--- problimatic to also provisoon it here.
+-- problimatic to also provisoon it here, when not booting up.
--
-- The solution is a flag file. If the flag file exists, then the container
-- was already provisioned. So, it must be a reboot, and time to provision
-- again. If the flag file doesn't exist, don't provision here.
-chain :: String -> IO ()
-chain s = case toContainerId s of
+init :: String -> IO ()
+init s = case toContainerId s of
Nothing -> error $ "Invalid ContainerId: " ++ s
Just cid -> do
changeWorkingDirectory localdir
writeFile propellorIdent . show =<< readIdentFile cid
- -- Run boot provisioning before starting simpleSh,
- -- to avoid ever provisioning twice at the same time.
whenM (checkProvisionedFlag cid) $ do
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
- unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ containerHostName cid]) $
+ unlessM (boolSystem shim [Param "--continue", Param $ show $ toChain cid]) $
warningMessage "Boot provision failed!"
void $ async $ job reapzombies
- void $ async $ job $ simpleSh $ namedPipe cid
job $ do
+ flushConcurrentOutput
void $ tryIO $ ifM (inPath "bash")
( boolSystem "bash" [Param "-l"]
, boolSystem "/bin/sh" []
@@ -432,36 +566,38 @@ chain s = case toContainerId s of
-- | Once a container is running, propellor can be run inside
-- it to provision it.
---
--- Note that there is a race here, between the simplesh
--- server starting up in the container, and this property
--- being run. So, retry connections to the client for up to
--- 1 minute.
-provisionContainer :: ContainerId -> Property
+provisionContainer :: ContainerId -> Property Linux
provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
- r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
+ let params = ["--continue", show $ toChain cid]
+ msgh <- getMessageHandle
+ let p = inContainerProcess cid
+ (if isConsole msgh then ["-it"] else [])
+ (shim : params)
+ r <- withHandle StdoutHandle createProcessSuccess p $
+ processChainOutput
when (r /= FailedChange) $
- setProvisionedFlag cid
+ setProvisionedFlag cid
return r
+
+toChain :: ContainerId -> CmdLine
+toChain cid = DockerChain (containerHostName cid) (fromContainerId cid)
+
+chain :: [Host] -> HostName -> String -> IO ()
+chain hostlist hn s = case toContainerId s of
+ Nothing -> errorMessage "bad container id"
+ Just cid -> case findHostNoAlias hostlist hn of
+ Nothing -> errorMessage ("cannot find host " ++ hn)
+ Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ fromInfo $ hostInfo parenthost) of
+ Nothing -> errorMessage ("cannot find container " ++ containerName cid ++ " docked on host " ++ hn)
+ Just h -> go cid h
where
- params = ["--continue", show $ Chain $ containerHostName cid]
-
- go lastline (v:rest) = case v of
- StdoutLine s -> do
- maybe noop putStrLn lastline
- hFlush stdout
- go (Just s) rest
- StderrLine s -> do
- maybe noop putStrLn lastline
- hFlush stdout
- hPutStrLn stderr s
- hFlush stderr
- go Nothing rest
- Done -> ret lastline
- go lastline [] = ret lastline
-
- ret lastline = pure $ fromMaybe FailedChange $ readish =<< lastline
+ go cid h = do
+ changeWorkingDirectory localdir
+ onlyProcess (provisioningLock cid) $ do
+ r <- runPropellor h $ ensureChildProperties $ hostProperties h
+ flushConcurrentOutput
+ putStrLn $ "\n" ++ show r
stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
@@ -469,17 +605,17 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId
startContainer :: ContainerId -> IO Bool
startContainer cid = boolSystem dockercmd [Param "start", Param $ fromContainerId cid ]
-stoppedContainer :: ContainerId -> Property
-stoppedContainer cid = containerDesc cid $ property desc $
+stoppedContainer :: ContainerId -> Property Linux
+stoppedContainer cid = containerDesc cid $ property' desc $ \w ->
ifM (liftIO $ elem cid <$> listContainers RunningContainers)
- ( liftIO cleanup `after` ensureProperty
- (boolProperty desc $ stopContainer cid)
+ ( liftIO cleanup `after` ensureProperty w stop
, return NoChange
)
where
desc = "stopped"
+ stop :: Property Linux
+ stop = property desc $ liftIO $ toResult <$> stopContainer cid
cleanup = do
- nukeFile $ namedPipe cid
nukeFile $ identFile cid
removeDirectoryRecursive $ shimdir cid
clearProvisionedFlag cid
@@ -488,17 +624,20 @@ removeContainer :: ContainerId -> IO Bool
removeContainer cid = catchBoolIO $
snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing
-removeImage :: Image -> IO Bool
+removeImage :: ImageIdentifier i => i -> IO Bool
removeImage image = catchBoolIO $
- snd <$> processTranscript dockercmd ["rmi", image ] Nothing
+ snd <$> processTranscript dockercmd ["rmi", imageIdentifier image] Nothing
-runContainer :: Image -> [RunParam] -> [String] -> IO Bool
+runContainer :: ImageIdentifier i => i -> [RunParam] -> [String] -> IO Bool
runContainer image ps cmd = boolSystem dockercmd $ map Param $
- "run" : (ps ++ image : cmd)
+ "run" : (ps ++ (imageIdentifier image) : cmd)
+
+inContainerProcess :: ContainerId -> [String] -> [String] -> CreateProcess
+inContainerProcess cid ps cmd = proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd)
-commitContainer :: ContainerId -> IO (Maybe Image)
+commitContainer :: ContainerId -> IO (Maybe ImageUID)
commitContainer cid = catchMaybeIO $
- takeWhile (/= '\n')
+ ImageUID . takeWhile (/= '\n')
<$> readProcess dockercmd ["commit", fromContainerId cid]
data ContainerFilter = RunningContainers | AllContainers
@@ -506,9 +645,9 @@ data ContainerFilter = RunningContainers | AllContainers
-- | Only lists propellor managed containers.
listContainers :: ContainerFilter -> IO [ContainerId]
-listContainers status =
- catMaybes . map toContainerId . concat . map (split ",")
- . catMaybes . map (lastMaybe . words) . lines
+listContainers status =
+ mapMaybe toContainerId . concatMap (split ",")
+ . mapMaybe (lastMaybe . words) . lines
<$> readProcess dockercmd ps
where
ps
@@ -516,32 +655,28 @@ listContainers status =
| otherwise = baseps
baseps = ["ps", "--no-trunc"]
-listImages :: IO [Image]
-listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
+listImages :: IO [ImageUID]
+listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
-runProp :: String -> RunParam -> Property
-runProp field val = pureInfoProperty (param) $ dockerInfo $
- mempty { _dockerRunParams = [\_ -> "--"++param] }
+runProp :: String -> RunParam -> Property (HasInfo + Linux)
+runProp field val = tightenTargets $ pureInfoProperty (param) $
+ mempty { _dockerRunParams = [DockerRunParam (\_ -> "--"++param)] }
where
param = field++"="++val
-genProp :: String -> (HostName -> RunParam) -> Property
-genProp field mkval = pureInfoProperty field $ dockerInfo $
- mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
+genProp :: String -> (HostName -> RunParam) -> Property (HasInfo + Linux)
+genProp field mkval = tightenTargets $ pureInfoProperty field $
+ mempty { _dockerRunParams = [DockerRunParam (\hn -> "--"++field++"=" ++ mkval hn)] }
dockerInfo :: DockerInfo -> Info
-dockerInfo i = mempty { _dockerinfo = i }
+dockerInfo i = mempty `addInfo` i
-- | The ContainerIdent of a container is written to
--- /.propellor-ident inside it. This can be checked to see if
+-- </.propellor-ident> inside it. This can be checked to see if
-- the container has the same ident later.
propellorIdent :: FilePath
propellorIdent = "/.propellor-ident"
--- | Named pipe used for communication with the container.
-namedPipe :: ContainerId -> FilePath
-namedPipe cid = "docker" </> fromContainerId cid
-
provisionedFlag :: ContainerId -> FilePath
provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"
@@ -556,6 +691,9 @@ setProvisionedFlag cid = do
checkProvisionedFlag :: ContainerId -> IO Bool
checkProvisionedFlag = doesFileExist . provisionedFlag
+provisioningLock :: ContainerId -> FilePath
+provisioningLock cid = "docker" </> fromContainerId cid ++ ".lock"
+
shimdir :: ContainerId -> FilePath
shimdir cid = "docker" </> fromContainerId cid ++ ".shim"
diff --git a/src/Propellor/Property/Fail2Ban.hs b/src/Propellor/Property/Fail2Ban.hs
new file mode 100644
index 00000000..9f147943
--- /dev/null
+++ b/src/Propellor/Property/Fail2Ban.hs
@@ -0,0 +1,30 @@
+module Propellor.Property.Fail2Ban where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+import Propellor.Property.ConfFile
+
+installed :: Property DebianLike
+installed = Apt.serviceInstalledRunning "fail2ban"
+
+reloaded :: Property DebianLike
+reloaded = Service.reloaded "fail2ban"
+
+type Jail = String
+
+-- | By default, fail2ban only enables the ssh jail, but many others
+-- are available to be enabled, for example "postfix-sasl"
+jailEnabled :: Jail -> Property DebianLike
+jailEnabled name = jailConfigured name "enabled" "true"
+ `onChange` reloaded
+
+-- | Configures a jail. For example:
+--
+-- > jailConfigured "sshd" "port" "2222"
+jailConfigured :: Jail -> IniKey -> String -> Property UnixLike
+jailConfigured name key value =
+ jailConfFile name `containsIniSetting` (name, key, value)
+
+jailConfFile :: Jail -> FilePath
+jailConfFile name = "/etc/fail2ban/jail.d/" ++ name ++ ".conf"
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index bc499e07..e072fcaa 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -1,46 +1,62 @@
module Propellor.Property.File where
-import Propellor
+import Propellor.Base
import Utility.FileMode
import System.Posix.Files
-import System.PosixCompat.Types
+import System.Exit
type Line = String
-- | Replaces all the content of a file.
-hasContent :: FilePath -> [Line] -> Property
-f `hasContent` newcontent = fileProperty ("replace " ++ f)
+hasContent :: FilePath -> [Line] -> Property UnixLike
+f `hasContent` newcontent = fileProperty
+ ("replace " ++ f)
+ (\_oldcontent -> newcontent) f
+
+-- | Replaces all the content of a file, ensuring that its modes do not
+-- allow it to be read or written by anyone other than the current user
+hasContentProtected :: FilePath -> [Line] -> Property UnixLike
+f `hasContentProtected` newcontent = fileProperty' writeFileProtected
+ ("replace " ++ f)
(\_oldcontent -> newcontent) f
-- | Ensures a file has contents that comes from PrivData.
--
-- The file's permissions are preserved if the file already existed.
-- Otherwise, they're set to 600.
-hasPrivContent :: FilePath -> Context -> Property
-hasPrivContent = hasPrivContent' writeFileProtected
+hasPrivContent :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
+hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f
+
+-- | Like hasPrivContent, but allows specifying a source
+-- for PrivData, rather than using PrivDataSourceFile .
+hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
+hasPrivContentFrom = hasPrivContent' writeFileProtected
-- | Leaves the file at its default or current mode,
-- allowing "private" data to be read.
--
-- Use with caution!
-hasPrivContentExposed :: FilePath -> Context -> Property
-hasPrivContentExposed = hasPrivContent' writeFile
-
-hasPrivContent' :: (String -> FilePath -> IO ()) -> FilePath -> Context -> Property
-hasPrivContent' writer f context =
- withPrivData (PrivFile f) context $ \getcontent ->
- property desc $ getcontent $ \privcontent ->
- ensureProperty $ fileProperty' writer desc
- (\_oldcontent -> lines privcontent) f
+hasPrivContentExposed :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
+hasPrivContentExposed f = hasPrivContentExposedFrom (PrivDataSourceFile (PrivFile f) f) f
+
+hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
+hasPrivContentExposedFrom = hasPrivContent' writeFile
+
+hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
+hasPrivContent' writer source f context =
+ withPrivData source context $ \getcontent ->
+ property' desc $ \o -> getcontent $ \privcontent ->
+ ensureProperty o $ fileProperty' writer desc
+ (\_oldcontent -> privDataLines privcontent) f
where
desc = "privcontent " ++ f
-- | Ensures that a line is present in a file, adding it to the end if not.
-containsLine :: FilePath -> Line -> Property
+containsLine :: FilePath -> Line -> Property UnixLike
f `containsLine` l = f `containsLines` [l]
-containsLines :: FilePath -> [Line] -> Property
+containsLines :: FilePath -> [Line] -> Property UnixLike
f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
where
go content = content ++ filter (`notElem` content) ls
@@ -48,52 +64,134 @@ f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
-- | Ensures that a line is not present in a file.
-- Note that the file is ensured to exist, so if it doesn't, an empty
-- file will be written.
-lacksLine :: FilePath -> Line -> Property
+lacksLine :: FilePath -> Line -> Property UnixLike
f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
+lacksLines :: FilePath -> [Line] -> Property UnixLike
+f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f
+
+-- | Replaces the content of a file with the transformed content of another file
+basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike
+f `basedOn` (f', a) = property' desc $ \o -> do
+ tmpl <- liftIO $ readFile f'
+ ensureProperty o $ fileProperty desc (\_ -> a $ lines $ tmpl) f
+ where
+ desc = "replace " ++ f
+
-- | Removes a file. Does not remove symlinks or non-plain-files.
-notPresent :: FilePath -> Property
+notPresent :: FilePath -> Property UnixLike
notPresent f = check (doesFileExist f) $ property (f ++ " not present") $
makeChange $ nukeFile f
-fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
+fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike
fileProperty = fileProperty' writeFile
-fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property
+fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike
fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
where
go True = do
- ls <- liftIO $ lines <$> readFile f
- let ls' = a ls
- if ls' == ls
+ old <- liftIO $ readFile f
+ let new = unlines (a (lines old))
+ if old == new
then noChange
- else makeChange $ viaTmp updatefile f (unlines ls')
+ else makeChange $ updatefile new `viaStableTmp` f
go False = makeChange $ writer f (unlines $ a [])
- -- viaTmp makes the temp file mode 600.
-- Replicate the original file's owner and mode.
- updatefile f' content = do
+ updatefile content f' = do
writer f' content
s <- getFileStatus f
setFileMode f' (fileMode s)
setOwnerAndGroup f' (fileOwner s) (fileGroup s)
-- | Ensures a directory exists.
-dirExists :: FilePath -> Property
+dirExists :: FilePath -> Property UnixLike
dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $
makeChange $ createDirectoryIfMissing True d
+-- | The location that a symbolic link points to.
+newtype LinkTarget = LinkTarget FilePath
+
+-- | Creates or atomically updates a symbolic link.
+--
+-- Does not overwrite regular files or directories.
+isSymlinkedTo :: FilePath -> LinkTarget -> Property UnixLike
+link `isSymlinkedTo` (LinkTarget target) = property desc $
+ go =<< (liftIO $ tryIO $ getSymbolicLinkStatus link)
+ where
+ desc = link ++ " is symlinked to " ++ target
+ go (Right stat) =
+ if isSymbolicLink stat
+ then checkLink
+ else nonSymlinkExists
+ go (Left _) = makeChange $ createSymbolicLink target link
+
+ nonSymlinkExists = do
+ warningMessage $ link ++ " exists and is not a symlink"
+ return FailedChange
+ checkLink = do
+ target' <- liftIO $ readSymbolicLink link
+ if target == target'
+ then noChange
+ else makeChange updateLink
+ updateLink = createSymbolicLink target `viaStableTmp` link
+
+-- | Ensures that a file is a copy of another (regular) file.
+isCopyOf :: FilePath -> FilePath -> Property UnixLike
+f `isCopyOf` f' = property desc $ go =<< (liftIO $ tryIO $ getFileStatus f')
+ where
+ desc = f ++ " is copy of " ++ f'
+ go (Right stat) = if isRegularFile stat
+ then gocmp =<< (liftIO $ cmp)
+ else warningMessage (f' ++ " is not a regular file") >>
+ return FailedChange
+ go (Left e) = warningMessage (show e) >> return FailedChange
+
+ cmp = safeSystem "cmp" [Param "-s", Param "--", File f, File f']
+ gocmp ExitSuccess = noChange
+ gocmp (ExitFailure 1) = doit
+ gocmp _ = warningMessage "cmp failed" >> return FailedChange
+
+ doit = makeChange $ copy f' `viaStableTmp` f
+ copy src dest = unlessM (runcp src dest) $ errorMessage "cp failed"
+ runcp src dest = boolSystem "cp"
+ [Param "--preserve=all", Param "--", File src, File dest]
+
-- | Ensures that a file/dir has the specified owner and group.
-ownerGroup :: FilePath -> UserName -> GroupName -> Property
-ownerGroup f owner group = property (f ++ " owner " ++ og) $ do
- r <- ensureProperty $ cmdProperty "chown" [og, f]
- if r == FailedChange
- then return r
- else noChange
+ownerGroup :: FilePath -> User -> Group -> Property UnixLike
+ownerGroup f (User owner) (Group group) = p `describe` (f ++ " owner " ++ og)
where
+ p = cmdProperty "chown" [og, f]
+ `changesFile` f
og = owner ++ ":" ++ group
-- | Ensures that a file/dir has the specfied mode.
-mode :: FilePath -> FileMode -> Property
-mode f v = property (f ++ " mode " ++ show v) $ do
- liftIO $ modifyFileMode f (\_old -> v)
- noChange
+mode :: FilePath -> FileMode -> Property UnixLike
+mode f v = p `changesFile` f
+ where
+ p = property (f ++ " mode " ++ show v) $ do
+ liftIO $ modifyFileMode f (const v)
+ return NoChange
+
+-- | A temp file to use when writing new content for a file.
+--
+-- This is a stable name so it can be removed idempotently.
+--
+-- It ends with "~" so that programs that read many config files from a
+-- directory will treat it as an editor backup file, and not read it.
+stableTmpFor :: FilePath -> FilePath
+stableTmpFor f = f ++ ".propellor-new~"
+
+-- | Creates/updates a file atomically, running the action to create the
+-- stable tmp file, and then renaming it into place.
+viaStableTmp :: (MonadMask m, MonadIO m) => (FilePath -> m ()) -> FilePath -> m ()
+viaStableTmp a f = bracketIO setup cleanup go
+ where
+ setup = do
+ createDirectoryIfMissing True (takeDirectory f)
+ let tmpfile = stableTmpFor f
+ nukeFile tmpfile
+ return tmpfile
+ cleanup tmpfile = tryIO $ removeFile tmpfile
+ go tmpfile = do
+ a tmpfile
+ liftIO $ rename tmpfile f
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index b660207b..3ea19ffa 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -1,88 +1,202 @@
--- |Properties for configuring firewall (iptables) rules
+-- | Maintainer: Arnaud Bailly <arnaud.oqube@gmail.com>
--
--- Copyright 2014 Arnaud Bailly <arnaud.oqube@gmail.com>
--- License: BSD-2-Clause
+-- Properties for configuring firewall (iptables) rules
+
module Propellor.Property.Firewall (
rule,
installed,
Chain(..),
+ Table(..),
Target(..),
Proto(..),
Rules(..),
- ConnectionState(..)
+ ConnectionState(..),
+ ICMPTypeMatch(..),
+ TCPFlag(..),
+ Frequency(..),
+ IPWithMask(..),
+ fromIPWithMask
) where
import Data.Monoid
import Data.Char
import Data.List
-import Propellor
-import Utility.SafeCommand
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Network as Network
-installed :: Property
+installed :: Property DebianLike
installed = Apt.installed ["iptables"]
-rule :: Chain -> Target -> Rules -> Property
-rule c t rs = property ("firewall rule: " <> show r) addIpTable
+rule :: Chain -> Table -> Target -> Rules -> Property Linux
+rule c tb tg rs = property ("firewall rule: " <> show r) addIpTable
where
- r = Rule c t rs
+ r = Rule c tb tg rs
addIpTable = liftIO $ do
let args = toIpTable r
exist <- boolSystem "iptables" (chk args)
if exist
then return NoChange
- else ifM (boolSystem "iptables" (add args))
- ( return MadeChange , return FailedChange)
- add params = (Param "-A") : params
- chk params = (Param "-C") : params
+ else toResult <$> boolSystem "iptables" (add args)
+ add params = Param "-A" : params
+ chk params = Param "-C" : params
toIpTable :: Rule -> [CommandParam]
toIpTable r = map Param $
- (show $ ruleChain r) :
- (toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ]
+ fromChain (ruleChain r) :
+ toIpTableArg (ruleRules r) ++
+ ["-t", fromTable (ruleTable r), "-j", fromTarget (ruleTarget r)]
toIpTableArg :: Rules -> [String]
-toIpTableArg Everything = []
-toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
-toIpTableArg (Port port) = ["--dport", show port]
-toIpTableArg (PortRange (f,t)) = ["--dport", show f ++ ":" ++ show t]
-toIpTableArg (IFace iface) = ["-i", iface]
-toIpTableArg (Ctstate states) = ["-m", "conntrack","--ctstate", concat $ intersperse "," (map show states)]
-toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
+toIpTableArg Everything = []
+toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
+toIpTableArg (DPort port) = ["--dport", fromPort port]
+toIpTableArg (DPortRange (portf, portt)) =
+ ["--dport", fromPort portf ++ ":" ++ fromPort portt]
+toIpTableArg (InIFace iface) = ["-i", iface]
+toIpTableArg (OutIFace iface) = ["-o", iface]
+toIpTableArg (Ctstate states) =
+ [ "-m"
+ , "conntrack"
+ , "--ctstate", intercalate "," (map show states)
+ ]
+toIpTableArg (ICMPType i) =
+ [ "-m"
+ , "icmp"
+ , "--icmp-type", fromICMPTypeMatch i
+ ]
+toIpTableArg (RateLimit f) =
+ [ "-m"
+ , "limit"
+ , "--limit", fromFrequency f
+ ]
+toIpTableArg (TCPFlags m c) =
+ [ "-m"
+ , "tcp"
+ , "--tcp-flags"
+ , intercalate "," (map show m)
+ , intercalate "," (map show c)
+ ]
+toIpTableArg TCPSyn = ["--syn"]
+toIpTableArg (GroupOwner (Group g)) =
+ [ "-m"
+ , "owner"
+ , "--gid-owner"
+ , g
+ ]
+toIpTableArg (Source ipwm) =
+ [ "-s"
+ , intercalate "," (map fromIPWithMask ipwm)
+ ]
+toIpTableArg (Destination ipwm) =
+ [ "-d"
+ , intercalate "," (map fromIPWithMask ipwm)
+ ]
+toIpTableArg (NotDestination ipwm) =
+ [ "!"
+ , "-d"
+ , intercalate "," (map fromIPWithMask ipwm)
+ ]
+toIpTableArg (NatDestination ip mport) =
+ [ "--to-destination"
+ , fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport
+ ]
+toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
+
+data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int
+ deriving (Eq, Show)
+
+fromIPWithMask :: IPWithMask -> String
+fromIPWithMask (IPWithNoMask ip) = fromIPAddr ip
+fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm
+fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m
data Rule = Rule
- { ruleChain :: Chain
+ { ruleChain :: Chain
+ , ruleTable :: Table
, ruleTarget :: Target
- , ruleRules :: Rules
- } deriving (Eq, Show, Read)
+ , ruleRules :: Rules
+ } deriving (Eq, Show)
-data Chain = INPUT | OUTPUT | FORWARD
- deriving (Eq,Show,Read)
+data Table = Filter | Nat | Mangle | Raw | Security
+ deriving (Eq, Show)
-data Target = ACCEPT | REJECT | DROP | LOG
- deriving (Eq,Show,Read)
+fromTable :: Table -> String
+fromTable Filter = "filter"
+fromTable Nat = "nat"
+fromTable Mangle = "mangle"
+fromTable Raw = "raw"
+fromTable Security = "security"
-data Proto = TCP | UDP | ICMP
- deriving (Eq,Show,Read)
+data Target = ACCEPT | REJECT | DROP | LOG | TargetCustom String
+ deriving (Eq, Show)
-type Port = Int
+fromTarget :: Target -> String
+fromTarget ACCEPT = "ACCEPT"
+fromTarget REJECT = "REJECT"
+fromTarget DROP = "DROP"
+fromTarget LOG = "LOG"
+fromTarget (TargetCustom t) = t
+
+data Chain = INPUT | OUTPUT | FORWARD | PREROUTING | POSTROUTING | ChainCustom String
+ deriving (Eq, Show)
+
+fromChain :: Chain -> String
+fromChain INPUT = "INPUT"
+fromChain OUTPUT = "OUTPUT"
+fromChain FORWARD = "FORWARD"
+fromChain PREROUTING = "PREROUTING"
+fromChain POSTROUTING = "POSTROUTING"
+fromChain (ChainCustom c) = c
+
+data Proto = TCP | UDP | ICMP
+ deriving (Eq, Show)
data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID
- deriving (Eq,Show,Read)
+ deriving (Eq, Show)
+
+data ICMPTypeMatch = ICMPTypeName String | ICMPTypeCode Int
+ deriving (Eq, Show)
+
+fromICMPTypeMatch :: ICMPTypeMatch -> String
+fromICMPTypeMatch (ICMPTypeName t) = t
+fromICMPTypeMatch (ICMPTypeCode c) = show c
+
+data Frequency = NumBySecond Int
+ deriving (Eq, Show)
+
+fromFrequency :: Frequency -> String
+fromFrequency (NumBySecond n) = show n ++ "/second"
+
+type TCPFlagMask = [TCPFlag]
+
+type TCPFlagComp = [TCPFlag]
+
+data TCPFlag = SYN | ACK | FIN | RST | URG | PSH | ALL | NONE
+ deriving (Eq, Show)
data Rules
= Everything
| Proto Proto
-- ^There is actually some order dependency between proto and port so this should be a specific
-- data type with proto + ports
- | Port Port
- | PortRange (Port,Port)
- | IFace Network.Interface
+ | DPort Port
+ | DPortRange (Port, Port)
+ | InIFace Network.Interface
+ | OutIFace Network.Interface
| Ctstate [ ConnectionState ]
+ | ICMPType ICMPTypeMatch
+ | RateLimit Frequency
+ | TCPFlags TCPFlagMask TCPFlagComp
+ | TCPSyn
+ | GroupOwner Group
+ | Source [ IPWithMask ]
+ | Destination [ IPWithMask ]
+ | NotDestination [ IPWithMask ]
+ | NatDestination IPAddr (Maybe Port)
| Rules :- Rules -- ^Combine two rules
- deriving (Eq,Show,Read)
+ deriving (Eq, Show)
infixl 0 :-
diff --git a/src/Propellor/Property/FreeBSD.hs b/src/Propellor/Property/FreeBSD.hs
new file mode 100644
index 00000000..af83fa8c
--- /dev/null
+++ b/src/Propellor/Property/FreeBSD.hs
@@ -0,0 +1,13 @@
+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
+--
+-- FreeBSD Properties
+--
+-- This module is designed to be imported unqualified.
+
+module Propellor.Property.FreeBSD (
+ module Propellor.Property.FreeBSD.Pkg,
+ module Propellor.Property.FreeBSD.Poudriere
+) where
+
+import Propellor.Property.FreeBSD.Pkg
+import Propellor.Property.FreeBSD.Poudriere
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
new file mode 100644
index 00000000..704c1db9
--- /dev/null
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -0,0 +1,88 @@
+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
+--
+-- FreeBSD pkgng properties
+
+{-# Language ScopedTypeVariables, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+
+module Propellor.Property.FreeBSD.Pkg where
+
+import Propellor.Base
+import Propellor.Types.Info
+
+noninteractiveEnv :: [([Char], [Char])]
+noninteractiveEnv = [("ASSUME_ALWAYS_YES", "yes")]
+
+pkgCommand :: String -> [String] -> (String, [String])
+pkgCommand cmd args = ("pkg", (cmd:args))
+
+runPkg :: String -> [String] -> IO [String]
+runPkg cmd args =
+ let
+ (p, a) = pkgCommand cmd args
+ in
+ lines <$> readProcess p a
+
+pkgCmdProperty :: String -> [String] -> UncheckedProperty FreeBSD
+pkgCmdProperty cmd args = tightenTargets $
+ let
+ (p, a) = pkgCommand cmd args
+ in
+ cmdPropertyEnv p a noninteractiveEnv
+
+pkgCmd :: String -> [String] -> IO [String]
+pkgCmd cmd args =
+ let
+ (p, a) = pkgCommand cmd args
+ in
+ lines <$> readProcessEnv p a (Just noninteractiveEnv)
+
+newtype PkgUpdate = PkgUpdate String
+ deriving (Typeable, Monoid, Show)
+instance IsInfo PkgUpdate where
+ propagateInfo _ = False
+
+pkgUpdated :: PkgUpdate -> Bool
+pkgUpdated (PkgUpdate _) = True
+
+update :: Property (HasInfo + FreeBSD)
+update =
+ let
+ upd = pkgCmd "update" []
+ go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
+ in
+ (property "pkg update has run" go :: Property FreeBSD)
+ `setInfoProperty` (toInfo (PkgUpdate ""))
+
+newtype PkgUpgrade = PkgUpgrade String
+ deriving (Typeable, Monoid, Show)
+instance IsInfo PkgUpgrade where
+ propagateInfo _ = False
+
+pkgUpgraded :: PkgUpgrade -> Bool
+pkgUpgraded (PkgUpgrade _) = True
+
+upgrade :: Property (HasInfo + FreeBSD)
+upgrade =
+ let
+ upd = pkgCmd "upgrade" []
+ go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
+ in
+ (property "pkg upgrade has run" go :: Property FreeBSD)
+ `setInfoProperty` (toInfo (PkgUpdate ""))
+ `requires` update
+
+type Package = String
+
+installed :: Package -> Property FreeBSD
+installed pkg = check (isInstallable pkg) $ pkgCmdProperty "install" [pkg]
+
+isInstallable :: Package -> IO Bool
+isInstallable p = (not <$> isInstalled p) <&&> exists p
+
+isInstalled :: Package -> IO Bool
+isInstalled p = (runPkg "info" [p] >> return True)
+ `catchIO` (\_ -> return False)
+
+exists :: Package -> IO Bool
+exists p = (runPkg "search" ["--search", "name", "--exact", p] >> return True)
+ `catchIO` (\_ -> return False)
diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
new file mode 100644
index 00000000..fcad9e87
--- /dev/null
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -0,0 +1,144 @@
+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
+--
+-- FreeBSD Poudriere properties
+
+{-# Language GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+
+module Propellor.Property.FreeBSD.Poudriere where
+
+import Propellor.Base
+import Propellor.Types.Info
+import Data.List
+import Data.String (IsString(..))
+
+import qualified Propellor.Property.FreeBSD.Pkg as Pkg
+import qualified Propellor.Property.ZFS as ZFS
+import qualified Propellor.Property.File as File
+
+poudriereConfigPath :: FilePath
+poudriereConfigPath = "/usr/local/etc/poudriere.conf"
+
+newtype PoudriereConfigured = PoudriereConfigured String
+ deriving (Typeable, Monoid, Show)
+instance IsInfo PoudriereConfigured where
+ propagateInfo _ = False
+
+poudriereConfigured :: PoudriereConfigured -> Bool
+poudriereConfigured (PoudriereConfigured _) = True
+
+setConfigured :: Property (HasInfo + FreeBSD)
+setConfigured = tightenTargets $
+ pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
+
+poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
+poudriere conf@(Poudriere _ _ _ _ _ _ zfs) = prop
+ `requires` Pkg.installed "poudriere"
+ `before` setConfigured
+ where
+ confProp :: Property FreeBSD
+ confProp = tightenTargets $
+ File.containsLines poudriereConfigPath (toLines conf)
+ setZfs (PoudriereZFS z p) = ZFS.zfsSetProperties z p `describe` "Configuring Poudriere with ZFS"
+ prop :: Property FreeBSD
+ prop
+ | isJust zfs = ((setZfs $ fromJust zfs) `before` confProp)
+ | otherwise = confProp `describe` "Configuring Poudriere without ZFS"
+
+poudriereCommand :: String -> [String] -> (String, [String])
+poudriereCommand cmd args = ("poudriere", cmd:args)
+
+runPoudriere :: String -> [String] -> IO [String]
+runPoudriere cmd args =
+ let
+ (p, a) = poudriereCommand cmd args
+ in
+ lines <$> readProcess p a
+
+listJails :: IO [String]
+listJails = mapMaybe (headMaybe . take 1 . words)
+ <$> runPoudriere "jail" ["-l", "-q"]
+
+jailExists :: Jail -> IO Bool
+jailExists (Jail name _ _) = isInfixOf [name] <$> listJails
+
+jail :: Jail -> Property FreeBSD
+jail j@(Jail name version arch) = tightenTargets $
+ let
+ chk = do
+ c <- poudriereConfigured <$> askInfo
+ nx <- liftIO $ not <$> jailExists j
+ return $ c && nx
+
+ (cmd, args) = poudriereCommand "jail" ["-c", "-j", name, "-a", show arch, "-v", show version]
+ createJail = cmdProperty cmd args
+ in
+ check chk createJail
+ `describe` unwords ["Create poudriere jail", name]
+
+data JailInfo = JailInfo String
+
+data Poudriere = Poudriere
+ { _resolvConf :: String
+ , _freebsdHost :: String
+ , _baseFs :: String
+ , _usePortLint :: Bool
+ , _distFilesCache :: FilePath
+ , _svnHost :: String
+ , _zfs :: Maybe PoudriereZFS
+ }
+
+defaultConfig :: Poudriere
+defaultConfig = Poudriere
+ "/etc/resolv.conf"
+ "ftp://ftp5.us.FreeBSD.org"
+ "/usr/local/poudriere"
+ True
+ "/usr/ports/distfiles"
+ "svn.freebsd.org"
+ Nothing
+
+data PoudriereZFS = PoudriereZFS ZFS.ZFS ZFS.ZFSProperties
+
+data Jail = Jail String FBSDVersion PoudriereArch
+
+data PoudriereArch = I386 | AMD64 deriving (Eq)
+instance Show PoudriereArch where
+ show I386 = "i386"
+ show AMD64 = "amd64"
+
+instance IsString PoudriereArch where
+ fromString "i386" = I386
+ fromString "amd64" = AMD64
+ fromString _ = error "Not a valid Poudriere architecture."
+
+yesNoProp :: Bool -> String
+yesNoProp b = if b then "yes" else "no"
+
+instance ToShellConfigLines Poudriere where
+ toAssoc c = map (\(k, f) -> (k, f c))
+ [ ("RESOLV_CONF", _resolvConf)
+ , ("FREEBSD_HOST", _freebsdHost)
+ , ("BASEFS", _baseFs)
+ , ("USE_PORTLINT", yesNoProp . _usePortLint)
+ , ("DISTFILES_CACHE", _distFilesCache)
+ , ("SVN_HOST", _svnHost)
+ ] ++ maybe [ ("NO_ZFS", "yes") ] toAssoc (_zfs c)
+
+instance ToShellConfigLines PoudriereZFS where
+ toAssoc (PoudriereZFS (ZFS.ZFS (ZFS.ZPool pool) dataset) _) =
+ [ ("NO_ZFS", "no")
+ , ("ZPOOL", pool)
+ , ("ZROOTFS", show dataset)
+ ]
+
+type ConfigLine = String
+type ConfigFile = [ConfigLine]
+
+class ToShellConfigLines a where
+ toAssoc :: a -> [(String, String)]
+
+ toLines :: a -> [ConfigLine]
+ toLines c = map (\(k, v) -> intercalate "=" [k, v]) (toAssoc c)
+
+confFile :: FilePath
+confFile = "/usr/local/etc/poudriere.conf"
diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs
new file mode 100644
index 00000000..60f11d8e
--- /dev/null
+++ b/src/Propellor/Property/Fstab.hs
@@ -0,0 +1,111 @@
+module Propellor.Property.Fstab (
+ FsType,
+ Source,
+ MountPoint,
+ MountOpts(..),
+ module Propellor.Property.Fstab,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import Propellor.Property.Mount
+
+import Data.Char
+import Data.List
+import Utility.Table
+
+-- | Ensures that </etc/fstab> contains a line mounting the specified
+-- `Source` on the specified `MountPoint`, and that it's currently mounted.
+--
+-- For example:
+--
+-- > mounted "auto" "/dev/sdb1" "/srv" mempty
+--
+-- Note that if anything else is already mounted at the `MountPoint`, it
+-- will be left as-is by this property.
+mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property Linux
+mounted fs src mnt opts = tightenTargets $
+ "/etc/fstab" `File.containsLine` l
+ `describe` (mnt ++ " mounted by fstab")
+ `onChange` mountnow
+ where
+ l = intercalate "\t" [src, mnt, fs, formatMountOpts opts, dump, passno]
+ dump = "0"
+ passno = "2"
+ -- This use of mountPoints, which is linux-only, is why this
+ -- property currently only supports linux.
+ mountnow = check (notElem mnt <$> mountPoints) $
+ cmdProperty "mount" [mnt]
+
+newtype SwapPartition = SwapPartition FilePath
+
+-- | Replaces </etc/fstab> with a file that should cause the currently
+-- mounted partitions to be re-mounted the same way on boot.
+--
+-- For each specified MountPoint, the UUID of each partition
+-- (or if there is no UUID, its label), its filesystem type,
+-- and its mount options are all automatically probed.
+--
+-- The SwapPartitions are also included in the generated fstab.
+fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux
+fstabbed mnts swaps = property' "fstabbed" $ \o -> do
+ fstab <- liftIO $ genFstab mnts swaps id
+ ensureProperty o $
+ "/etc/fstab" `File.hasContent` fstab
+
+genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String]
+genFstab mnts swaps mnttransform = do
+ fstab <- liftIO $ mapM getcfg (sort mnts)
+ swapfstab <- liftIO $ mapM getswapcfg swaps
+ return $ header ++ formatTable (legend : fstab ++ swapfstab)
+ where
+ header =
+ [ "# /etc/fstab: static file system information. See fstab(5)"
+ , "# "
+ ]
+ legend = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]
+ getcfg mnt = sequence
+ [ fromMaybe (error $ "unable to find mount source for " ++ mnt)
+ <$> getM (\a -> a mnt)
+ [ uuidprefix getMountUUID
+ , sourceprefix getMountLabel
+ , getMountSource
+ ]
+ , pure (mnttransform mnt)
+ , fromMaybe "auto" <$> getFsType mnt
+ , formatMountOpts <$> getFsMountOpts mnt
+ , pure "0"
+ , pure (if mnt == "/" then "1" else "2")
+ ]
+ getswapcfg (SwapPartition swap) = sequence
+ [ fromMaybe swap <$> getM (\a -> a swap)
+ [ uuidprefix getSourceUUID
+ , sourceprefix getSourceLabel
+ ]
+ , pure "none"
+ , pure "swap"
+ , pure (formatMountOpts mempty)
+ , pure "0"
+ , pure "0"
+ ]
+ prefix s getter m = fmap (s ++) <$> getter m
+ uuidprefix = prefix "UUID="
+ sourceprefix = prefix "LABEL="
+
+-- | Checks if </etc/fstab> is not configured.
+-- This is the case if it doesn't exist, or
+-- consists entirely of blank lines or comments.
+--
+-- So, if you want to only replace the fstab once, and then never touch it
+-- again, allowing local modifications:
+--
+-- > check noFstab (fstabbed mnts [])
+noFstab :: IO Bool
+noFstab = ifM (doesFileExist "/etc/fstab")
+ ( null . filter iscfg . lines <$> readFile "/etc/fstab"
+ , return True
+ )
+ where
+ iscfg l
+ | null l = False
+ | otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l
diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs
index e5df7e48..5d7c8b4d 100644
--- a/src/Propellor/Property/Git.hs
+++ b/src/Propellor/Property/Git.hs
@@ -1,10 +1,9 @@
module Propellor.Property.Git where
-import Propellor
+import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
-import Utility.SafeCommand
import Data.List
@@ -12,8 +11,8 @@ import Data.List
-- using git-daemon, run from inetd.
--
-- Note that reverting this property does not remove or stop inetd.
-daemonRunning :: FilePath -> RevertableProperty
-daemonRunning exportdir = RevertableProperty setup unsetup
+daemonRunning :: FilePath -> RevertableProperty DebianLike DebianLike
+daemonRunning exportdir = setup <!> unsetup
where
setup = containsLine conf (mkl "tcp4")
`requires`
@@ -23,7 +22,7 @@ daemonRunning exportdir = RevertableProperty setup unsetup
`requires`
Apt.serviceInstalledRunning "openbsd-inetd"
`onChange`
- Service.running "openbsd-inetd"
+ Service.reloaded "openbsd-inetd"
`describe` ("git-daemon exporting " ++ exportdir)
unsetup = lacksLine conf (mkl "tcp4")
`requires`
@@ -48,7 +47,7 @@ daemonRunning exportdir = RevertableProperty setup unsetup
, exportdir
]
-installed :: Property
+installed :: Property DebianLike
installed = Apt.installed ["git"]
type RepoUrl = String
@@ -57,12 +56,13 @@ type Branch = String
-- | Specified git repository is cloned to the specified directory.
--
--- If the firectory exists with some other content, it will be recursively
--- deleted.
+-- If the directory exists with some other content (either a non-git
+-- repository, or a git repository cloned from some other location),
+-- it will be recursively deleted first.
--
-- A branch can be specified, to check out.
-cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property
-cloned owner url dir mbranch = check originurl (property desc checkout)
+cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike
+cloned owner url dir mbranch = check originurl go
`requires` installed
where
desc = "git cloned " ++ url ++ " to " ++ dir
@@ -74,20 +74,90 @@ cloned owner url dir mbranch = check originurl (property desc checkout)
return (v /= Just url)
, return True
)
- checkout = do
+ go :: Property DebianLike
+ go = property' desc $ \w -> do
liftIO $ do
whenM (doesDirectoryExist dir) $
removeDirectoryRecursive dir
createDirectoryIfMissing True (takeDirectory dir)
- ensureProperty $ userScriptProperty owner $ catMaybes
- -- The </dev/null fixes an intermittent
- -- "fatal: read error: Bad file descriptor"
- -- when run across ssh with propellor --spin
- [ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
- , Just $ "cd " ++ shellEscape dir
- , ("git checkout " ++) <$> mbranch
- -- In case this repo is exposted via the web,
- -- although the hook to do this ongoing is not
- -- installed here.
- , Just "git update-server-info"
+ ensureProperty w $ userScriptProperty owner (catMaybes checkoutcmds)
+ `assume` MadeChange
+ checkoutcmds =
+ -- The </dev/null fixes an intermittent
+ -- "fatal: read error: Bad file descriptor"
+ -- when run across ssh with propellor --spin
+ [ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
+ , Just $ "cd " ++ shellEscape dir
+ , ("git checkout " ++) <$> mbranch
+ -- In case this repo is exposted via the web,
+ -- although the hook to do this ongoing is not
+ -- installed here.
+ , Just "git update-server-info"
+ ]
+
+isGitDir :: FilePath -> IO Bool
+isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir])
+
+data GitShared = Shared Group | SharedAll | NotShared
+
+bareRepo :: FilePath -> User -> GitShared -> Property UnixLike
+bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ toProps $
+ dirExists repo : case gitshared of
+ NotShared ->
+ [ ownerGroup repo user (userGroup user)
+ , userScriptProperty user ["git init --bare --shared=false " ++ shellEscape repo]
+ `assume` MadeChange
+ ]
+ SharedAll ->
+ [ ownerGroup repo user (userGroup user)
+ , userScriptProperty user ["git init --bare --shared=all " ++ shellEscape repo]
+ `assume` MadeChange
]
+ Shared group' ->
+ [ ownerGroup repo user group'
+ , userScriptProperty user ["git init --bare --shared=group " ++ shellEscape repo]
+ `assume` MadeChange
+ ]
+ where
+ isRepo repo' = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", repo'])
+
+-- | Set a key value pair in a git repo's configuration.
+repoConfigured :: FilePath -> (String, String) -> Property UnixLike
+repo `repoConfigured` (key, value) = check (not <$> alreadyconfigured) $
+ userScriptProperty (User "root")
+ [ "cd " ++ repo
+ , "git config " ++ key ++ " " ++ value
+ ]
+ `assume` MadeChange
+ `describe` desc
+ where
+ alreadyconfigured = do
+ vs <- getRepoConfig repo key
+ return $ value `elem` vs
+ desc = "git repo at " ++ repo ++ " config setting " ++ key ++ " set to " ++ value
+
+-- | Gets the value that a key is set to in a git repo's configuration.
+getRepoConfig :: FilePath -> String -> IO [String]
+getRepoConfig repo key = catchDefaultIO [] $
+ lines <$> readProcess "git" ["-C", repo, "config", key]
+
+-- | Whether a repo accepts non-fast-forward pushes.
+repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
+repoAcceptsNonFFs repo = accepts <!> refuses
+ where
+ accepts = repoConfigured repo ("receive.denyNonFastForwards", "false")
+ `describe` desc "accepts"
+ refuses = repoConfigured repo ("receive.denyNonFastForwards", "true")
+ `describe` desc "rejects"
+ desc s = "git repo " ++ repo ++ " " ++ s ++ " non-fast-forward pushes"
+
+-- | Sets a bare repository's default branch, which will be checked out
+-- when cloning it.
+bareRepoDefaultBranch :: FilePath -> String -> Property UnixLike
+bareRepoDefaultBranch repo branch =
+ userScriptProperty (User "root")
+ [ "cd " ++ repo
+ , "git symbolic-ref HEAD refs/heads/" ++ branch
+ ]
+ `changesFileContent` (repo </> "HEAD")
+ `describe` ("git repo at " ++ repo ++ " has default branch " ++ branch)
diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs
index b4698663..74e9df5a 100644
--- a/src/Propellor/Property/Gpg.hs
+++ b/src/Propellor/Property/Gpg.hs
@@ -1,15 +1,18 @@
module Propellor.Property.Gpg where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import Utility.FileSystemEncoding
import System.PosixCompat
-installed :: Property
+installed :: Property DebianLike
installed = Apt.installed ["gnupg"]
-type GpgKeyId = String
+-- A numeric id, or a description of the key, in a form understood by gpg.
+newtype GpgKeyId = GpgKeyId { getGpgKeyId :: String }
+
+data GpgKeyType = GpgPubKey | GpgPrivKey
-- | Sets up a user with a gpg key from the privdata.
--
@@ -19,26 +22,42 @@ type GpgKeyId = String
--
-- Recommend only using this for low-value dedicated role keys.
-- No attempt has been made to scrub the key out of memory once it's used.
---
--- The GpgKeyId does not have to be a numeric id; it can just as easily
--- be a description of the key.
-keyImported :: GpgKeyId -> UserName -> Property
-keyImported keyid user = flagFile' prop genflag
+keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike)
+keyImported key@(GpgKeyId keyid) user@(User u) = prop
`requires` installed
where
- desc = user ++ " has gpg key " ++ show keyid
- genflag = do
- d <- dotDir user
- return $ d </> ".propellor-imported-keyid-" ++ keyid
- prop = withPrivData GpgKey (Context keyid) $ \getkey ->
- property desc $ getkey $ \key -> makeChange $
- withHandle StdinHandle createProcessSuccess
- (proc "su" ["-c", "gpg --import", user]) $ \h -> do
- fileEncoding h
- hPutStr h key
- hClose h
-
-dotDir :: UserName -> IO FilePath
-dotDir user = do
- home <- homeDirectory <$> getUserEntryForName user
+ desc = u ++ " has gpg key " ++ show keyid
+ prop :: Property (HasInfo + DebianLike)
+ prop = withPrivData src (Context keyid) $ \getkey ->
+ property desc $ getkey $ \key' -> do
+ let keylines = privDataLines key'
+ ifM (liftIO $ hasGpgKey (parse keylines))
+ ( return NoChange
+ , makeChange $ withHandle StdinHandle createProcessSuccess
+ (proc "su" ["-c", "gpg --import", u]) $ \h -> do
+ fileEncoding h
+ hPutStr h (unlines keylines)
+ hClose h
+ )
+ src = PrivDataSource GpgKey "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a"
+
+ parse ("-----BEGIN PGP PUBLIC KEY BLOCK-----":_) = Just GpgPubKey
+ parse ("-----BEGIN PGP PRIVATE KEY BLOCK-----":_) = Just GpgPrivKey
+ parse _ = Nothing
+
+ hasGpgKey Nothing = error $ "Failed to run gpg parser on armored key " ++ keyid
+ hasGpgKey (Just GpgPubKey) = hasPubKey key user
+ hasGpgKey (Just GpgPrivKey) = hasPrivKey key user
+
+hasPrivKey :: GpgKeyId -> User -> IO Bool
+hasPrivKey (GpgKeyId keyid) (User u) = catchBoolIO $
+ snd <$> processTranscript "su" ["-c", "gpg --list-secret-keys " ++ shellEscape keyid, u] Nothing
+
+hasPubKey :: GpgKeyId -> User -> IO Bool
+hasPubKey (GpgKeyId keyid) (User u) = catchBoolIO $
+ snd <$> processTranscript "su" ["-c", "gpg --list-public-keys " ++ shellEscape keyid, u] Nothing
+
+dotDir :: User -> IO FilePath
+dotDir (User u) = do
+ home <- homeDirectory <$> getUserEntryForName u
return $ home </> ".gnupg"
diff --git a/src/Propellor/Property/Group.hs b/src/Propellor/Property/Group.hs
new file mode 100644
index 00000000..58e49a86
--- /dev/null
+++ b/src/Propellor/Property/Group.hs
@@ -0,0 +1,14 @@
+module Propellor.Property.Group where
+
+import Propellor.Base
+
+type GID = Int
+
+exists :: Group -> Maybe GID -> Property UnixLike
+exists (Group group') mgid = check test (cmdProperty "addgroup" (args mgid))
+ `describe` unwords ["group", group']
+ where
+ groupFile = "/etc/group"
+ test = not . elem group' . words <$> readProcess "cut" ["-d:", "-f1", groupFile]
+ args Nothing = [group']
+ args (Just gid) = ["--gid", show gid, group']
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index 841861f4..a03fc5a0 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -1,26 +1,73 @@
module Propellor.Property.Grub where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
--- | Eg, hd0,0 or xen/xvda1
+-- | Eg, \"hd0,0\" or \"xen/xvda1\"
type GrubDevice = String
+-- | Eg, \"\/dev/sda\"
+type OSDevice = String
+
type TimeoutSecs = Int
+-- | Types of machines that grub can boot.
+data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen
+
+-- | Installs the grub package. This does not make grub be used as the
+-- bootloader.
+--
+-- This includes running update-grub.
+installed :: BIOS -> Property DebianLike
+installed bios = installed' bios `onChange` mkConfig
+
+-- Run update-grub, to generate the grub boot menu. It will be
+-- automatically updated when kernel packages are installed.
+mkConfig :: Property DebianLike
+mkConfig = tightenTargets $ cmdProperty "update-grub" []
+ `assume` MadeChange
+
+-- | Installs grub; does not run update-grub.
+installed' :: BIOS -> Property Linux
+installed' bios = (aptinstall `pickOS` unsupportedOS)
+ `describe` "grub package installed"
+ where
+ aptinstall :: Property DebianLike
+ aptinstall = Apt.installed [debpkg]
+ debpkg = case bios of
+ PC -> "grub-pc"
+ EFI64 -> "grub-efi-amd64"
+ EFI32 -> "grub-efi-ia32"
+ Coreboot -> "grub-coreboot"
+ Xen -> "grub-xen"
+
+-- | Installs grub onto a device, so the system can boot from that device.
+--
+-- You may want to install grub to multiple devices; eg for a system
+-- that uses software RAID.
+--
+-- Note that this property does not check if grub is already installed
+-- on the device; it always does the work to reinstall it. It's a good idea
+-- to arrange for this property to only run once, by eg making it be run
+-- onChange after OS.cleanInstallOnce.
+boots :: OSDevice -> Property Linux
+boots dev = tightenTargets $ cmdProperty "grub-install" [dev]
+ `assume` MadeChange
+ `describe` ("grub boots " ++ dev)
+
-- | Use PV-grub chaining to boot
--
-- Useful when the VPS's pv-grub is too old to boot a modern kernel image.
--
--- http://notes.pault.ag/linode-pv-grub-chainning/
+-- <http://notes.pault.ag/linode-pv-grub-chainning/>
--
-- The rootdev should be in the form "hd0", while the bootdev is in the form
-- "xen/xvda".
-chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property
-chainPVGrub rootdev bootdev timeout = combineProperties desc
- [ File.dirExists "/boot/grub"
- , "/boot/grub/menu.lst" `File.hasContent`
+chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property DebianLike
+chainPVGrub rootdev bootdev timeout = combineProperties desc $ props
+ & File.dirExists "/boot/grub"
+ & "/boot/grub/menu.lst" `File.hasContent`
[ "default 1"
, "timeout " ++ show timeout
, ""
@@ -29,11 +76,12 @@ chainPVGrub rootdev bootdev timeout = combineProperties desc
, "kernel /boot/xen-shim"
, "boot"
]
- , "/boot/load.cf" `File.hasContent`
+ & "/boot/load.cf" `File.hasContent`
[ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ]
- , Apt.installed ["grub-xen"]
- , flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"
- `describe` "/boot-xen-shim"
- ]
+ & installed Xen
+ & flip flagFile "/boot/xen-shim" xenshim
where
desc = "chain PV-grub"
+ xenshim = scriptProperty ["grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]
+ `assume` MadeChange
+ `describe` "/boot-xen-shim"
diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
index 003bd3c5..5c4788e2 100644
--- a/src/Propellor/Property/HostingProvider/CloudAtCost.hs
+++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
@@ -1,24 +1,29 @@
module Propellor.Property.HostingProvider.CloudAtCost where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Hostname as Hostname
import qualified Propellor.Property.File as File
-import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.User as User
-- Clean up a system as installed by cloudatcost.com
-decruft :: Property
-decruft = propertyList "cloudatcost cleanup"
- [ Hostname.sane
- , Ssh.randomHostKeys
- , "worked around grub/lvm boot bug #743126" ==>
+decruft :: Property DebianLike
+decruft = propertyList "cloudatcost cleanup" $ props
+ & Hostname.sane
+ & grubbugfix
+ & nukecruft
+ where
+ grubbugfix :: Property DebianLike
+ grubbugfix = tightenTargets $
"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
- `onChange` cmdProperty "update-grub" []
- `onChange` cmdProperty "update-initramfs" ["-u"]
- , combineProperties "nuked cloudatcost cruft"
- [ File.notPresent "/etc/rc.local"
- , File.notPresent "/etc/init.d/S97-setup.sh"
- , User.nuked "user" User.YesReallyDeleteHome
- ]
- ]
+ `describe` "worked around grub/lvm boot bug #743126"
+ `onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
+ `onChange` (cmdProperty "update-initramfs" ["-u"] `assume` MadeChange)
+ nukecruft :: Property Linux
+ nukecruft = tightenTargets $
+ combineProperties "nuked cloudatcost cruft" $ props
+ & File.notPresent "/etc/rc.local"
+ & File.notPresent "/etc/init.d/S97-setup.sh"
+ & File.notPresent "/zang-debian.sh"
+ & File.notPresent "/bin/npasswd"
+ & User.nuked (User "user") User.YesReallyDeleteHome
diff --git a/src/Propellor/Property/HostingProvider/DigitalOcean.hs b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
index 4565935f..c1e0ffc9 100644
--- a/src/Propellor/Property/HostingProvider/DigitalOcean.hs
+++ b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
@@ -1,21 +1,49 @@
-module Propellor.Property.HostingProvider.DigitalOcean where
+module Propellor.Property.HostingProvider.DigitalOcean (
+ distroKernel
+) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Reboot as Reboot
--- Digital Ocean does not provide any way to boot
+import Data.List
+
+-- | Digital Ocean does not provide any way to boot
-- the kernel provided by the distribution, except using kexec.
-- Without this, some old, and perhaps insecure kernel will be used.
--
--- Note that this only causes the new kernel to be loaded on reboot.
--- If the power is cycled, the old kernel still boots up.
--- TODO: detect this and reboot immediately?
-distroKernel :: Property
-distroKernel = propertyList "digital ocean distro kernel hack"
- [ Apt.installed ["grub-pc", "kexec-tools"]
- , "/etc/default/kexec" `File.containsLines`
+-- This property causes the distro kernel to be loaded on reboot, using kexec.
+--
+-- If the power is cycled, the non-distro kernel still boots up.
+-- So, this property also checks if the running kernel is present in /boot,
+-- and if not, reboots immediately into a distro kernel.
+distroKernel :: Property DebianLike
+distroKernel = propertyList "digital ocean distro kernel hack" $ props
+ & Apt.installed ["grub-pc", "kexec-tools", "file"]
+ & "/etc/default/kexec" `File.containsLines`
[ "LOAD_KEXEC=true"
, "USE_GRUB_CONFIG=true"
] `describe` "kexec configured"
- ]
+ & check (not <$> runningInstalledKernel) Reboot.now
+ `describe` "running installed kernel"
+
+runningInstalledKernel :: IO Bool
+runningInstalledKernel = do
+ kernelver <- takeWhile (/= '\n') <$> readProcess "uname" ["-r"]
+ when (null kernelver) $
+ error "failed to read uname -r"
+ kernelimages <- concat <$> mapM kernelsIn ["/", "/boot/"]
+ when (null kernelimages) $
+ error "failed to find any installed kernel images"
+ findVersion kernelver <$>
+ readProcess "file" ("-L" : kernelimages)
+
+-- | File output looks something like this, we want to unambiguously
+-- match the running kernel version:
+-- Linux kernel x86 boot executable bzImage, version 3.16-3-amd64 (debian-kernel@lists.debian.org) #1 SMP Debian 3.1, RO-rootFS, swap_dev 0x2, Normal VGA
+findVersion :: String -> String -> Bool
+findVersion ver s = (" version " ++ ver ++ " ") `isInfixOf` s
+
+kernelsIn :: FilePath -> IO [FilePath]
+kernelsIn d = filter ("vmlinu" `isInfixOf`) <$> dirContents d
diff --git a/src/Propellor/Property/HostingProvider/Linode.hs b/src/Propellor/Property/HostingProvider/Linode.hs
index 34d72184..71719d87 100644
--- a/src/Propellor/Property/HostingProvider/Linode.hs
+++ b/src/Propellor/Property/HostingProvider/Linode.hs
@@ -1,10 +1,20 @@
module Propellor.Property.HostingProvider.Linode where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Grub as Grub
+import qualified Propellor.Property.File as File
+import Utility.FileMode
-- | Linode's pv-grub-x86_64 does not currently support booting recent
--- Debian kernels compressed with xz. This sets up pv-grub chaing to enable
+-- Debian kernels compressed with xz. This sets up pv-grub chaining to enable
-- it.
-chainPVGrub :: Grub.TimeoutSecs -> Property
+chainPVGrub :: Grub.TimeoutSecs -> Property DebianLike
chainPVGrub = Grub.chainPVGrub "hd0" "xen/xvda"
+
+-- | Linode disables mlocate's cron job's execute permissions,
+-- presumably to avoid disk IO. This ensures it's executable.
+mlocateEnabled :: Property DebianLike
+mlocateEnabled = tightenTargets $
+ "/etc/cron.daily/mlocate"
+ `File.mode` combineModes (readModes ++ executeModes)
+
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index c489e2fb..e1342d91 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -1,57 +1,80 @@
module Propellor.Property.Hostname where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
+import Propellor.Property.Chroot (inChroot)
import Data.List
+import Data.List.Utils
--- | Ensures that the hostname is set using best practices.
+-- | Ensures that the hostname is set using best practices, to whatever
+-- name the `Host` has.
--
--- Configures /etc/hostname and the current hostname.
+-- Configures both </etc/hostname> and the current hostname.
+-- (However, when used inside a chroot, avoids setting the current hostname
+-- as that would impact the system outside the chroot.)
--
--- Configures /etc/mailname with the domain part of the hostname.
+-- Configures </etc/mailname> with the domain part of the hostname.
--
--- /etc/hosts is also configured, with an entry for 127.0.1.1, which is
+-- </etc/hosts> is also configured, with an entry for 127.0.1.1, which is
-- standard at least on Debian to set the FDQN.
--
--- Also, the /etc/hosts 127.0.0.1 line is set to localhost. Putting any
+-- Also, the </etc/hosts> 127.0.0.1 line is set to localhost. Putting any
-- other hostnames there is not best practices and can lead to annoying
-- messages from eg, apache.
-sane :: Property
-sane = property ("sane hostname") (ensureProperty . setTo =<< asks hostName)
+sane :: Property UnixLike
+sane = sane' extractDomain
-setTo :: HostName -> Property
-setTo hn = combineProperties desc go
- where
- desc = "hostname " ++ hn
- (basehost, domain) = separate (== '.') hn
+sane' :: ExtractDomain -> Property UnixLike
+sane' extractdomain = property' ("sane hostname") $ \w ->
+ ensureProperty w . setTo' extractdomain =<< asks hostName
+
+-- Like `sane`, but you can specify the hostname to use, instead
+-- of the default hostname of the `Host`.
+setTo :: HostName -> Property UnixLike
+setTo = setTo' extractDomain
- go = catMaybes
- [ Just $ "/etc/hostname" `File.hasContent` [basehost]
- , if null domain
+setTo' :: ExtractDomain -> HostName -> Property UnixLike
+setTo' extractdomain hn = combineProperties desc $ toProps
+ [ "/etc/hostname" `File.hasContent` [basehost]
+ , hostslines $ catMaybes
+ [ if null domain
then Nothing
- else Just $ trivial $ hostsline "127.0.1.1" [hn, basehost]
- , Just $ trivial $ hostsline "127.0.0.1" ["localhost"]
- , Just $ trivial $ cmdProperty "hostname" [basehost]
- , Just $ "/etc/mailname" `File.hasContent`
- [if null domain then hn else domain]
+ else Just ("127.0.1.1", [hn, basehost])
+ , Just ("127.0.0.1", ["localhost"])
]
+ , check (not <$> inChroot) $
+ cmdProperty "hostname" [basehost]
+ `assume` NoChange
+ , "/etc/mailname" `File.hasContent`
+ [if null domain then hn else domain]
+ ]
+ where
+ desc = "hostname " ++ hn
+ basehost = takeWhile (/= '.') hn
+ domain = extractdomain hn
- hostsline ip names = File.fileProperty desc
- (addhostsline ip names)
- "/etc/hosts"
- addhostsline ip names ls =
- (ip ++ "\t" ++ (unwords names)) : filter (not . hasip ip) ls
- hasip ip l = headMaybe (words l) == Just ip
-
--- | Makes /etc/resolv.conf contain search and domain lines for
+ hostslines ipsnames =
+ File.fileProperty desc (addhostslines ipsnames) "/etc/hosts"
+ addhostslines :: [(String, [String])] -> [String] -> [String]
+ addhostslines ipsnames ls =
+ let ips = map fst ipsnames
+ hasip l = maybe False (`elem` ips) (headMaybe (words l))
+ mkline (ip, names) = ip ++ "\t" ++ (unwords names)
+ in map mkline ipsnames ++ filter (not . hasip) ls
+
+-- | Makes </etc/resolv.conf> contain search and domain lines for
-- the domain that the hostname is in.
-searchDomain :: Property
-searchDomain = property desc (ensureProperty . go =<< asks hostName)
+searchDomain :: Property UnixLike
+searchDomain = searchDomain' extractDomain
+
+searchDomain' :: ExtractDomain -> Property UnixLike
+searchDomain' extractdomain = property' desc $ \w ->
+ (ensureProperty w . go =<< asks hostName)
where
desc = "resolv.conf search and domain configured"
go hn =
- let (_basehost, domain) = separate (== '.') hn
+ let domain = extractdomain hn
in File.fileProperty desc (use domain) "/etc/resolv.conf"
use domain ls = filter wanted $ nub (ls ++ cfgs)
where
@@ -61,3 +84,21 @@ searchDomain = property desc (ensureProperty . go =<< asks hostName)
| "domain " `isPrefixOf` l = False
| "search " `isPrefixOf` l = False
| otherwise = True
+
+-- | Function to extract the domain name from a HostName.
+type ExtractDomain = HostName -> String
+
+-- | hostname of foo.example.com has a domain of example.com.
+-- But, when the hostname is example.com, the domain is
+-- example.com too.
+--
+-- This doesn't work for eg, foo.co.uk, or when foo.sci.uni.edu
+-- is in a sci.uni.edu subdomain. If you are in such a network,
+-- provide your own ExtractDomain function to the properties above.
+extractDomain :: ExtractDomain
+extractDomain hn =
+ let bits = split "." hn
+ in intercalate "." $
+ if length bits > 2
+ then drop 1 bits
+ else bits
diff --git a/src/Propellor/Property/Journald.hs b/src/Propellor/Property/Journald.hs
new file mode 100644
index 00000000..d0261626
--- /dev/null
+++ b/src/Propellor/Property/Journald.hs
@@ -0,0 +1,55 @@
+module Propellor.Property.Journald where
+
+import Propellor.Base
+import qualified Propellor.Property.Systemd as Systemd
+import Utility.DataUnits
+
+-- | Configures journald, restarting it so the changes take effect.
+configured :: Systemd.Option -> String -> Property Linux
+configured option value =
+ Systemd.configured "/etc/systemd/journald.conf" option value
+ `onChange` Systemd.restarted "systemd-journald"
+
+-- The string is parsed to get a data size.
+-- Examples: "100 megabytes" or "0.5tb"
+type DataSize = String
+
+configuredSize :: Systemd.Option -> DataSize -> Property Linux
+configuredSize option s = case readSize dataUnits s of
+ Just sz -> configured option (systemdSizeUnits sz)
+ Nothing -> property ("unable to parse " ++ option ++ " data size " ++ s) $
+ return FailedChange
+
+systemMaxUse :: DataSize -> Property Linux
+systemMaxUse = configuredSize "SystemMaxUse"
+
+runtimeMaxUse :: DataSize -> Property Linux
+runtimeMaxUse = configuredSize "RuntimeMaxUse"
+
+systemKeepFree :: DataSize -> Property Linux
+systemKeepFree = configuredSize "SystemKeepFree"
+
+runtimeKeepFree :: DataSize -> Property Linux
+runtimeKeepFree = configuredSize "RuntimeKeepFree"
+
+systemMaxFileSize :: DataSize -> Property Linux
+systemMaxFileSize = configuredSize "SystemMaxFileSize"
+
+runtimeMaxFileSize :: DataSize -> Property Linux
+runtimeMaxFileSize = configuredSize "RuntimeMaxFileSize"
+
+-- Generates size units as used in journald.conf.
+systemdSizeUnits :: Integer -> String
+systemdSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz)
+ where
+ cfgfileunits :: [Unit]
+ cfgfileunits =
+ [ Unit (p 6) "E" "exabyte"
+ , Unit (p 5) "P" "petabyte"
+ , Unit (p 4) "T" "terabyte"
+ , Unit (p 3) "G" "gigabyte"
+ , Unit (p 2) "M" "megabyte"
+ , Unit (p 1) "K" "kilobyte"
+ ]
+ p :: Integer -> Integer
+ p n = 1024^n
diff --git a/src/Propellor/Property/Kerberos.hs b/src/Propellor/Property/Kerberos.hs
new file mode 100644
index 00000000..3c351943
--- /dev/null
+++ b/src/Propellor/Property/Kerberos.hs
@@ -0,0 +1,95 @@
+-- | Maintainer: Jelmer Vernooij <jelmer@samba.org>
+
+module Propellor.Property.Kerberos where
+
+import Utility.Process
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+import Propellor.Property.User
+
+type Realm = String
+type Principal = String
+type Kvno = Integer
+
+-- Standard paths in MIT Kerberos
+
+defaultKeyTab :: FilePath
+defaultKeyTab = "/etc/krb5.keytab"
+
+kadmAclPath :: FilePath
+kadmAclPath = "/etc/krb5kdc/kadm5.acl"
+
+kpropdAclPath :: FilePath
+kpropdAclPath = "/etc/krb5kdc/kpropd.acl"
+
+kdcConfPath :: FilePath
+kdcConfPath = "/etc/krb5kdc/kdc.conf"
+
+keyTabPath :: Maybe FilePath -> FilePath
+keyTabPath = maybe defaultKeyTab id
+
+-- | Create a principal from a primary, instance and realm
+principal :: String -> Maybe String -> Maybe Realm -> Principal
+principal p i r = p ++ maybe "" ("/"++) i ++ maybe "" ("@" ++) r
+
+installed :: Property DebianLike
+installed = Apt.installed ["krb5-user"]
+
+kdcInstalled :: Property DebianLike
+kdcInstalled = Apt.serviceInstalledRunning "krb5-kdc"
+
+adminServerInstalled :: Property DebianLike
+adminServerInstalled = Apt.serviceInstalledRunning "krb5-admin-server"
+
+kpropServerInstalled :: Property DebianLike
+kpropServerInstalled = propertyList "kprop server installed" $ props
+ & kdcInstalled
+ & Apt.installed ["openbsd-inetd"]
+ & "/etc/inetd.conf" `File.containsLines`
+ [ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd"
+ , "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd"
+ ]
+
+kpropAcls :: [String] -> Property UnixLike
+kpropAcls ps = kpropdAclPath `File.hasContent` ps `describe` "kprop server ACLs"
+
+k5srvutil :: (Maybe FilePath) -> [String] -> IO String
+k5srvutil kt cmd = readProcess "k5srvutil" (maybe [] (\x -> ["-f", x]) kt ++ cmd)
+
+-- Keytab management
+keytabEntries :: Maybe FilePath -> IO [(Kvno, Principal)]
+keytabEntries p = do
+ c <- k5srvutil p ["list"]
+ return $ map parseLine (drop 3 $ lines c)
+ where
+ parseLine l = (Prelude.read x, y) where (x, y) = splitAt 5 l
+
+checkKeyTabEntry' :: Maybe FilePath -> (Kvno, Principal) -> IO Bool
+checkKeyTabEntry' path entry = do
+ entries <- keytabEntries path
+ return $ entry `elem` entries
+
+checkKeyTabEntry :: Maybe FilePath -> Principal -> IO Bool
+checkKeyTabEntry path princ = do
+ entries <- keytabEntries path
+ return $ princ `elem` (map snd entries)
+
+-- k5login files
+k5loginPath :: User -> IO FilePath
+k5loginPath user = do
+ h <- homedir user
+ return $ h </> ".k5login"
+
+k5login :: User -> [Principal] -> Property UnixLike
+k5login user@(User u) ps = property' desc $ \w -> do
+ f <- liftIO $ k5loginPath user
+ liftIO $ do
+ createDirectoryIfMissing True (takeDirectory f)
+ writeFile f (unlines ps)
+ ensureProperty w $ combineProperties desc $ props
+ & File.ownerGroup f user (userGroup user)
+ & File.ownerGroup (takeDirectory f) user (userGroup user)
+ where
+ desc = u ++ " has k5login"
diff --git a/src/Propellor/Property/LetsEncrypt.hs b/src/Propellor/Property/LetsEncrypt.hs
new file mode 100644
index 00000000..592a1e1d
--- /dev/null
+++ b/src/Propellor/Property/LetsEncrypt.hs
@@ -0,0 +1,109 @@
+-- | This module gets LetsEncrypt <https://letsencrypt.org/> certificates
+-- using CertBot <https://certbot.eff.org/>
+
+module Propellor.Property.LetsEncrypt where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+
+import System.Posix.Files
+
+-- Not using the certbot name yet, until it reaches jessie-backports and
+-- testing.
+installed :: Property DebianLike
+installed = Apt.installed ["letsencrypt"]
+
+-- | Tell the letsencrypt client that you agree with the Let's Encrypt
+-- Subscriber Agreement. Providing an email address is recommended,
+-- so that letcencrypt can contact you about problems.
+data AgreeTOS = AgreeTOS (Maybe Email)
+
+type Email = String
+
+type WebRoot = FilePath
+
+-- | Uses letsencrypt to obtain a certificate for a domain.
+--
+-- This should work with any web server, as long as letsencrypt can
+-- write its temp files to the web root. The letsencrypt client does
+-- not modify the web server's configuration in any way; this only obtains
+-- the certificate it does not make the web server use it.
+--
+-- This also handles renewing the certificate.
+-- For renewel to work well, propellor needs to be
+-- run periodically (at least a couple times per month).
+--
+-- This property returns `MadeChange` when the certificate is initially
+-- obtained, and when it's renewed. So, it can be combined with a property
+-- to make the webserver (or other server) use the certificate:
+--
+-- > letsEncrypt (AgreeTOS (Just "me@example.com")) "example.com" "/var/www"
+-- > `onChange` Apache.reload
+--
+-- See `Propellor.Property.Apache.httpsVirtualHost` for a more complete
+-- integration of apache with letsencrypt, that's built on top of this.
+letsEncrypt :: AgreeTOS -> Domain -> WebRoot -> Property DebianLike
+letsEncrypt tos domain = letsEncrypt' tos domain []
+
+-- | Like `letsEncrypt`, but the certificate can be obtained for multiple
+-- domains.
+letsEncrypt' :: AgreeTOS -> Domain -> [Domain] -> WebRoot -> Property DebianLike
+letsEncrypt' (AgreeTOS memail) domain domains webroot =
+ prop `requires` installed
+ where
+ prop :: Property UnixLike
+ prop = property desc $ do
+ startstats <- liftIO getstats
+ (transcript, ok) <- liftIO $
+ processTranscript "letsencrypt" params Nothing
+ if ok
+ then do
+ endstats <- liftIO getstats
+ if startstats /= endstats
+ then return MadeChange
+ else return NoChange
+ else do
+ liftIO $ hPutStr stderr transcript
+ return FailedChange
+
+ desc = "letsencrypt " ++ unwords alldomains
+ alldomains = domain : domains
+ params =
+ [ "certonly"
+ , "--agree-tos"
+ , case memail of
+ Just email -> "--email="++email
+ Nothing -> "--register-unsafely-without-email"
+ , "--webroot"
+ , "--webroot-path", webroot
+ , "--text"
+ , "--noninteractive"
+ , "--keep-until-expiring"
+ ] ++ map (\d -> "--domain="++d) alldomains
+
+ getstats = mapM statcertfiles alldomains
+ statcertfiles d = mapM statfile
+ [ certFile d
+ , privKeyFile d
+ , chainFile d
+ , fullChainFile d
+ ]
+ statfile f = catchMaybeIO $ do
+ s <- getFileStatus f
+ return (fileID s, deviceID s, fileMode s, fileSize s, modificationTime s)
+
+-- | The cerificate files that letsencrypt will make available for a domain.
+liveCertDir :: Domain -> FilePath
+liveCertDir d = "/etc/letsencrypt/live" </> d
+
+certFile :: Domain -> FilePath
+certFile d = liveCertDir d </> "cert.pem"
+
+privKeyFile :: Domain -> FilePath
+privKeyFile d = liveCertDir d </> "privkey.pem"
+
+chainFile :: Domain -> FilePath
+chainFile d = liveCertDir d </> "chain.pem"
+
+fullChainFile :: Domain -> FilePath
+fullChainFile d = liveCertDir d </> "fullchain.pem"
diff --git a/src/Propellor/Property/LightDM.hs b/src/Propellor/Property/LightDM.hs
new file mode 100644
index 00000000..339fa9a3
--- /dev/null
+++ b/src/Propellor/Property/LightDM.hs
@@ -0,0 +1,16 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+module Propellor.Property.LightDM where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.ConfFile as ConfFile
+
+installed :: Property DebianLike
+installed = Apt.installed ["lightdm"]
+
+-- | Configures LightDM to skip the login screen and autologin as a user.
+autoLogin :: User -> Property UnixLike
+autoLogin (User u) = "/etc/lightdm/lightdm.conf" `ConfFile.containsIniSetting`
+ ("SeatDefaults", "autologin-user", u)
+ `describe` "lightdm autologin"
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
new file mode 100644
index 00000000..0eec04c7
--- /dev/null
+++ b/src/Propellor/Property/List.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Propellor.Property.List (
+ props,
+ Props,
+ toProps,
+ propertyList,
+ combineProperties,
+) where
+
+import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
+import Propellor.PropAccum
+import Propellor.Engine
+import Propellor.Exception
+
+import Data.Monoid
+
+toProps :: [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
+toProps ps = Props (map toChildProperty ps)
+
+-- | Combines a list of properties, resulting in a single property
+-- that when run will run each property in the list in turn,
+-- and print out the description of each as it's run. Does not stop
+-- on failure; does propagate overall success/failure.
+--
+-- For example:
+--
+-- > propertyList "foo" $ props
+-- > & bar
+-- > & baz
+propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+propertyList desc (Props ps) =
+ property desc (ensureChildProperties cs)
+ `addChildren` cs
+ where
+ cs = map toChildProperty ps
+
+-- | Combines a list of properties, resulting in one property that
+-- ensures each in turn. Stops if a property fails.
+combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+combineProperties desc (Props ps) =
+ property desc (combineSatisfy cs NoChange)
+ `addChildren` cs
+ where
+ cs = map toChildProperty ps
+
+combineSatisfy :: [ChildProperty] -> Result -> Propellor Result
+combineSatisfy [] rs = return rs
+combineSatisfy (p:ps) rs = do
+ r <- catchPropellor $ getSatisfy p
+ case r of
+ FailedChange -> return FailedChange
+ _ -> combineSatisfy ps (r <> rs)
diff --git a/src/Propellor/Property/Locale.hs b/src/Propellor/Property/Locale.hs
new file mode 100644
index 00000000..b7cf242c
--- /dev/null
+++ b/src/Propellor/Property/Locale.hs
@@ -0,0 +1,83 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+module Propellor.Property.Locale where
+
+import Propellor.Base
+import Propellor.Property.File
+
+import Data.List (isPrefixOf)
+
+type Locale = String
+type LocaleVariable = String
+
+-- | Select a locale for a list of global locale variables.
+--
+-- A locale variable is of the form @LC_BLAH@, @LANG@ or @LANGUAGE@. See
+-- @locale(5)@. One might say
+--
+-- > & "en_GB.UTF-8" `Locale.selectedFor` ["LC_PAPER", "LC_MONETARY"]
+--
+-- to select the British English locale for paper size and currency conventions.
+--
+-- Note that reverting this property does not make a locale unavailable. That's
+-- because it might be required for other Locale.selectedFor statements.
+selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty DebianLike DebianLike
+locale `selectedFor` vars = select <!> deselect
+ where
+ select = tightenTargets $
+ check (not <$> isselected)
+ (cmdProperty "update-locale" selectArgs)
+ `requires` available locale
+ `describe` (locale ++ " locale selected")
+ deselect = tightenTargets $
+ check isselected (cmdProperty "update-locale" vars)
+ `describe` (locale ++ " locale deselected")
+ selectArgs = zipWith (++) vars (repeat ('=':locale))
+ isselected = locale `isSelectedFor` vars
+
+isSelectedFor :: Locale -> [LocaleVariable] -> IO Bool
+locale `isSelectedFor` vars = do
+ ls <- catchDefaultIO [] $ lines <$> readFile "/etc/default/locale"
+ return $ and $ map (\v -> v ++ "=" ++ locale `elem` ls) vars
+
+
+-- | Ensures a locale is generated (or, if reverted, ensure it's not).
+--
+-- Fails if a locale is not available to be generated. That is, a commented out
+-- entry for the locale and an accompanying charset must be present in
+-- /etc/locale.gen.
+--
+-- Per Debian bug #684134 we cannot ensure a locale is generated by means of
+-- Apt.reConfigure. So localeAvailable edits /etc/locale.gen manually.
+available :: Locale -> RevertableProperty DebianLike DebianLike
+available locale = ensureAvailable <!> ensureUnavailable
+ where
+ f = "/etc/locale.gen"
+ desc = (locale ++ " locale generated")
+ ensureAvailable :: Property DebianLike
+ ensureAvailable = property' desc $ \w -> do
+ locales <- lines <$> (liftIO $ readFile f)
+ if locale `presentIn` locales
+ then ensureProperty w $
+ fileProperty desc (foldr uncomment []) f
+ `onChange` regenerate
+ else return FailedChange -- locale unavailable for generation
+ ensureUnavailable :: Property DebianLike
+ ensureUnavailable = tightenTargets $
+ fileProperty (locale ++ " locale not generated") (foldr comment []) f
+ `onChange` regenerate
+
+ uncomment l ls =
+ if ("# " ++ locale) `isPrefixOf` l
+ then drop 2 l : ls
+ else l:ls
+ comment l ls =
+ if locale `isPrefixOf` l
+ then ("# " ++ l) : ls
+ else l:ls
+
+ l `presentIn` ls = any (l `isPrefix`) ls
+ l `isPrefix` x = (l `isPrefixOf` x) || (("# " ++ l) `isPrefixOf` x)
+
+ regenerate = cmdProperty "locale-gen" []
+ `assume` MadeChange
diff --git a/src/Propellor/Property/Logcheck.hs b/src/Propellor/Property/Logcheck.hs
new file mode 100644
index 00000000..ced9fce2
--- /dev/null
+++ b/src/Propellor/Property/Logcheck.hs
@@ -0,0 +1,36 @@
+-- | Maintainer: Jelmer Vernooij <jelmer@jelmer.uk>
+
+module Propellor.Property.Logcheck (
+ ReportLevel (Workstation, Server, Paranoid),
+ Service,
+ defaultPrefix,
+ ignoreFilePath,
+ ignoreLines,
+ installed,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+
+data ReportLevel = Workstation | Server | Paranoid
+type Service = String
+
+instance Show ReportLevel where
+ show Workstation = "workstation"
+ show Server = "server"
+ show Paranoid = "paranoid"
+
+-- The common prefix used by default in syslog lines.
+defaultPrefix :: String
+defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ "
+
+ignoreFilePath :: ReportLevel -> Service -> FilePath
+ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t) </> n
+
+ignoreLines :: ReportLevel -> Service -> [String] -> Property UnixLike
+ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls
+ `describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")")
+
+installed :: Property DebianLike
+installed = Apt.installed ["logcheck"]
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
new file mode 100644
index 00000000..bb0f60a7
--- /dev/null
+++ b/src/Propellor/Property/Mount.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
+
+-- | Properties in this module ensure that things are currently mounted,
+-- but without making the mount persistent. Use `Propellor.Property.Fstab`
+-- to configure persistent mounts.
+
+module Propellor.Property.Mount where
+
+import Propellor.Base
+import Utility.Path
+
+import Data.List
+
+-- | type of filesystem to mount ("auto" to autodetect)
+type FsType = String
+
+-- | A device or other thing to be mounted.
+type Source = String
+
+-- | A mount point for a filesystem.
+type MountPoint = FilePath
+
+-- | Filesystem mount options. Eg, MountOpts ["errors=remount-ro"]
+--
+-- For default mount options, use `mempty`.
+newtype MountOpts = MountOpts [String]
+ deriving Monoid
+
+class ToMountOpts a where
+ toMountOpts :: a -> MountOpts
+
+instance ToMountOpts MountOpts where
+ toMountOpts = id
+
+instance ToMountOpts String where
+ toMountOpts s = MountOpts [s]
+
+formatMountOpts :: MountOpts -> String
+formatMountOpts (MountOpts []) = "defaults"
+formatMountOpts (MountOpts l) = intercalate "," l
+
+-- | Mounts a device, without listing it in </etc/fstab>.
+mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike
+mounted fs src mnt opts = property (mnt ++ " mounted") $
+ toResult <$> liftIO (mount fs src mnt opts)
+
+-- | Bind mounts the first directory so its contents also appear
+-- in the second directory.
+bindMount :: FilePath -> FilePath -> Property Linux
+bindMount src dest = tightenTargets $
+ cmdProperty "mount" ["--bind", src, dest]
+ `assume` MadeChange
+ `describe` ("bind mounted " ++ src ++ " to " ++ dest)
+
+mount :: FsType -> Source -> MountPoint -> MountOpts -> IO Bool
+mount fs src mnt opts = boolSystem "mount" $
+ [ Param "-t", Param fs
+ , Param "-o", Param (formatMountOpts opts)
+ , Param src
+ , Param mnt
+ ]
+
+-- | Lists all mount points of the system.
+mountPoints :: IO [MountPoint]
+mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]
+
+-- | Finds all filesystems mounted inside the specified directory.
+mountPointsBelow :: FilePath -> IO [MountPoint]
+mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target)
+ . filter (dirContains target)
+ <$> mountPoints
+
+-- | Filesystem type mounted at a given location.
+getFsType :: MountPoint -> IO (Maybe FsType)
+getFsType = findmntField "fstype"
+
+-- | Mount options for the filesystem mounted at a given location.
+getFsMountOpts :: MountPoint -> IO MountOpts
+getFsMountOpts p = maybe mempty toMountOpts
+ <$> findmntField "fs-options" p
+
+type UUID = String
+
+-- | UUID of filesystem mounted at a given location.
+getMountUUID :: MountPoint -> IO (Maybe UUID)
+getMountUUID = findmntField "uuid"
+
+-- | UUID of a device
+getSourceUUID :: Source -> IO (Maybe UUID)
+getSourceUUID = blkidTag "UUID"
+
+type Label = String
+
+-- | Label of filesystem mounted at a given location.
+getMountLabel :: MountPoint -> IO (Maybe Label)
+getMountLabel = findmntField "label"
+
+-- | Label of a device
+getSourceLabel :: Source -> IO (Maybe UUID)
+getSourceLabel = blkidTag "LABEL"
+
+-- | Device mounted at a given location.
+getMountSource :: MountPoint -> IO (Maybe Source)
+getMountSource = findmntField "source"
+
+findmntField :: String -> FilePath -> IO (Maybe String)
+findmntField field mnt = catchDefaultIO Nothing $
+ headMaybe . filter (not . null) . lines
+ <$> readProcess "findmnt" ["-n", mnt, "--output", field]
+
+blkidTag :: String -> Source -> IO (Maybe String)
+blkidTag tag dev = catchDefaultIO Nothing $
+ headMaybe . filter (not . null) . lines
+ <$> readProcess "blkid" [dev, "-s", tag, "-o", "value"]
+
+-- | Unmounts a device or mountpoint,
+-- lazily so any running processes don't block it.
+umountLazy :: FilePath -> IO ()
+umountLazy mnt =
+ unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $
+ errorMessage $ "failed unmounting " ++ mnt
+
+-- | Unmounts anything mounted inside the specified directory.
+unmountBelow :: FilePath -> IO ()
+unmountBelow d = do
+ submnts <- mountPointsBelow d
+ forM_ submnts umountLazy
diff --git a/src/Propellor/Property/Munin.hs b/src/Propellor/Property/Munin.hs
new file mode 100644
index 00000000..dd74d91b
--- /dev/null
+++ b/src/Propellor/Property/Munin.hs
@@ -0,0 +1,56 @@
+-- | Maintainer: Jelmer Vernooij <jelmer@jelmer.uk>
+--
+module Propellor.Property.Munin (
+ hostListFragment,
+ hostListFragment',
+ nodePort,
+ nodeInstalled,
+ nodeRestarted,
+ nodeConfPath,
+ masterInstalled,
+ masterRestarted,
+ masterConfPath,
+) where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+nodePort :: Integer
+nodePort = 4949
+
+nodeInstalled :: Property DebianLike
+nodeInstalled = Apt.serviceInstalledRunning "munin-node"
+
+nodeRestarted :: Property DebianLike
+nodeRestarted = Service.restarted "munin-node"
+
+nodeConfPath :: FilePath
+nodeConfPath = "/etc/munin/munin-node.conf"
+
+masterInstalled :: Property DebianLike
+masterInstalled = Apt.serviceInstalledRunning "munin"
+
+masterRestarted :: Property DebianLike
+masterRestarted = Service.restarted "munin"
+
+masterConfPath :: FilePath
+masterConfPath = "/etc/munin/munin.conf"
+
+
+-- | Create the host list fragment for master config.
+-- Takes an optional override list for hosts that are accessible on a non-standard host/port.
+-- TODO(jelmer): Only do this on hosts where munin is present (in other words, with Munin.installedNode)
+hostListFragment' :: [Host] -> [(HostName, (IPAddr, Port))] -> [String]
+hostListFragment' hs os = concatMap muninHost hs
+ where
+ muninHost :: Host -> [String]
+ muninHost h = [ "[" ++ (hostName h) ++ "]"
+ , " address " ++ maybe (hostName h) (fromIPAddr . fst) (hOverride h)
+ ] ++ (maybe [] (\x -> [" port " ++ (fromPort $ snd x)]) (hOverride h)) ++ [""]
+ hOverride :: Host -> Maybe (IPAddr, Port)
+ hOverride h = lookup (hostName h) os
+
+-- | Create the host list fragment for master config.
+hostListFragment :: [Host] -> [String]
+hostListFragment hs = hostListFragment' hs []
diff --git a/src/Propellor/Property/Network.hs b/src/Propellor/Property/Network.hs
index 6009778a..9ed9e591 100644
--- a/src/Propellor/Property/Network.hs
+++ b/src/Propellor/Property/Network.hs
@@ -1,30 +1,116 @@
module Propellor.Property.Network where
-import Propellor
+import Propellor.Base
import Propellor.Property.File
-interfaces :: FilePath
-interfaces = "/etc/network/interfaces"
+import Data.Char
+
+type Interface = String
+
+ifUp :: Interface -> Property DebianLike
+ifUp iface = tightenTargets $ cmdProperty "ifup" [iface]
+ `assume` MadeChange
+
+-- | Resets /etc/network/interfaces to a clean and empty state,
+-- containing just the standard loopback interface, and with
+-- interfacesD enabled.
+--
+-- This can be used as a starting point to defining other interfaces.
+--
+-- No interfaces are brought up or down by this property.
+cleanInterfacesFile :: Property DebianLike
+cleanInterfacesFile = tightenTargets $ hasContent interfacesFile
+ [ "# Deployed by propellor, do not edit."
+ , ""
+ , "source-directory interfaces.d"
+ , ""
+ , "# The loopback network interface"
+ , "auto lo"
+ , "iface lo inet loopback"
+ ]
+ `describe` ("clean " ++ interfacesFile)
+
+-- | Configures an interface to get its address via dhcp.
+dhcp :: Interface -> Property DebianLike
+dhcp iface = tightenTargets $ hasContent (interfaceDFile iface)
+ [ "auto " ++ iface
+ , "iface " ++ iface ++ " inet dhcp"
+ ]
+ `describe` ("dhcp " ++ iface)
+ `requires` interfacesDEnabled
+
+-- | Writes a static interface file for the specified interface.
+--
+-- The interface has to be up already. It could have been brought up by
+-- DHCP, or by other means. The current ipv4 addresses
+-- and routing configuration of the interface are written into the file.
+--
+-- If the interface file already exists, this property does nothing,
+-- no matter its content.
+--
+-- (ipv6 addresses are not included because it's assumed they come up
+-- automatically in most situations.)
+static :: Interface -> Property DebianLike
+static iface = tightenTargets $
+ check (not <$> doesFileExist f) setup
+ `describe` desc
+ `requires` interfacesDEnabled
+ where
+ f = interfaceDFile iface
+ desc = "static " ++ iface
+ setup :: Property DebianLike
+ setup = property' desc $ \o -> do
+ ls <- liftIO $ lines <$> readProcess "ip"
+ ["-o", "addr", "show", iface, "scope", "global"]
+ stanzas <- liftIO $ concat <$> mapM mkstanza ls
+ ensureProperty o $ hasContent f $ ("auto " ++ iface) : stanzas
+ mkstanza ipline = case words ipline of
+ -- Note that the IP address is written CIDR style, so
+ -- the netmask does not need to be specified separately.
+ (_:iface':"inet":addr:_) | iface' == iface -> do
+ gw <- getgateway
+ return $ catMaybes
+ [ Just $ "iface " ++ iface ++ " inet static"
+ , Just $ "\taddress " ++ addr
+ , ("\tgateway " ++) <$> gw
+ ]
+ _ -> return []
+ getgateway = do
+ rs <- lines <$> readProcess "ip"
+ ["route", "show", "scope", "global", "dev", iface]
+ return $ case words <$> headMaybe rs of
+ Just ("default":"via":gw:_) -> Just gw
+ _ -> Nothing
-- | 6to4 ipv6 connection, should work anywhere
-ipv6to4 :: Property
-ipv6to4 = fileProperty "ipv6to4" go interfaces
+ipv6to4 :: Property DebianLike
+ipv6to4 = tightenTargets $ hasContent (interfaceDFile "sit0")
+ [ "# Deployed by propellor, do not edit."
+ , "iface sit0 inet6 static"
+ , "\taddress 2002:5044:5531::1"
+ , "\tnetmask 64"
+ , "\tgateway ::192.88.99.1"
+ , "auto sit0"
+ ]
+ `describe` "ipv6to4"
+ `requires` interfacesDEnabled
`onChange` ifUp "sit0"
- where
- go ls
- | all (`elem` ls) stanza = ls
- | otherwise = ls ++ stanza
- stanza =
- [ "# Automatically added by propeller"
- , "iface sit0 inet6 static"
- , "\taddress 2002:5044:5531::1"
- , "\tnetmask 64"
- , "\tgateway ::192.88.99.1"
- , "auto sit0"
- , "# End automatically added by propeller"
- ]
-type Interface = String
+interfacesFile :: FilePath
+interfacesFile = "/etc/network/interfaces"
+
+-- | A file in the interfaces.d directory.
+interfaceDFile :: Interface -> FilePath
+interfaceDFile i = "/etc/network/interfaces.d" </> escapeInterfaceDName i
+
+-- | /etc/network/interfaces.d/ files have to match -- ^[a-zA-Z0-9_-]+$
+-- see "man 5 interfaces"
+escapeInterfaceDName :: Interface -> FilePath
+escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-"))
-ifUp :: Interface -> Property
-ifUp iface = cmdProperty "ifup" [iface]
+-- | Ensures that files in the the interfaces.d directory are used.
+-- interfacesDEnabled :: Property DebianLike
+interfacesDEnabled :: Property DebianLike
+interfacesDEnabled = tightenTargets $
+ containsLine interfacesFile "source-directory interfaces.d"
+ `describe` "interfaces.d directory enabled"
diff --git a/src/Propellor/Property/Nginx.hs b/src/Propellor/Property/Nginx.hs
index 397570d2..e40ba657 100644
--- a/src/Propellor/Property/Nginx.hs
+++ b/src/Propellor/Property/Nginx.hs
@@ -1,37 +1,32 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+
module Propellor.Property.Nginx where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
-import System.Posix.Files
type ConfigFile = [String]
-siteEnabled :: HostName -> ConfigFile -> RevertableProperty
-siteEnabled hn cf = RevertableProperty enable disable
+siteEnabled :: HostName -> ConfigFile -> RevertableProperty DebianLike DebianLike
+siteEnabled hn cf = enable <!> disable
where
- enable = check test prop
+ enable = siteVal hn `File.isSymlinkedTo` siteValRelativeCfg hn
`describe` ("nginx site enabled " ++ hn)
`requires` siteAvailable hn cf
`requires` installed
`onChange` reloaded
- where
- test = not <$> doesFileExist (siteVal hn)
- prop = property "nginx site in place" $ makeChange $
- createSymbolicLink target dir
- target = siteValRelativeCfg hn
- dir = siteVal hn
- disable = trivial $ File.notPresent (siteVal hn)
+ disable = File.notPresent (siteVal hn)
`describe` ("nginx site disable" ++ hn)
`requires` installed
`onChange` reloaded
-siteAvailable :: HostName -> ConfigFile -> Property
-siteAvailable hn cf = ("nginx site available " ++ hn) ==>
- siteCfg hn `File.hasContent` (comment : cf)
+siteAvailable :: HostName -> ConfigFile -> Property DebianLike
+siteAvailable hn cf = "nginx site available " ++ hn ==> tightenTargets go
where
comment = "# deployed with propellor, do not modify"
+ go = siteCfg hn `File.hasContent` (comment : cf)
siteCfg :: HostName -> FilePath
siteCfg hn = "/etc/nginx/sites-available/" ++ hn
@@ -39,14 +34,14 @@ siteCfg hn = "/etc/nginx/sites-available/" ++ hn
siteVal :: HostName -> FilePath
siteVal hn = "/etc/nginx/sites-enabled/" ++ hn
-siteValRelativeCfg :: HostName -> FilePath
-siteValRelativeCfg hn = "../sites-available/" ++ hn
+siteValRelativeCfg :: HostName -> File.LinkTarget
+siteValRelativeCfg hn = File.LinkTarget ("../sites-available/" ++ hn)
-installed :: Property
+installed :: Property DebianLike
installed = Apt.installed ["nginx"]
-restarted :: Property
+restarted :: Property DebianLike
restarted = Service.restarted "nginx"
-reloaded :: Property
+reloaded :: Property DebianLike
reloaded = Service.reloaded "nginx"
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
new file mode 100644
index 00000000..5a3ccc70
--- /dev/null
+++ b/src/Propellor/Property/OS.hs
@@ -0,0 +1,253 @@
+module Propellor.Property.OS (
+ cleanInstallOnce,
+ Confirmation(..),
+ preserveNetwork,
+ preserveResolvConf,
+ preserveRootSshAuthorized,
+ oldOSRemoved,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.Debootstrap as Debootstrap
+import qualified Propellor.Property.Ssh as Ssh
+import qualified Propellor.Property.Network as Network
+import qualified Propellor.Property.User as User
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Reboot as Reboot
+import Propellor.Property.Mount
+import Propellor.Property.Chroot.Util (stdPATH)
+
+import System.Posix.Files (rename, fileExist)
+import Control.Exception (throw)
+
+-- | Replaces whatever OS was installed before with a clean installation
+-- of the OS that the Host is configured to have.
+--
+-- This is experimental; use with caution!
+--
+-- This can replace one Linux distribution with different one.
+-- But, it can also fail and leave the system in an unbootable state.
+--
+-- To avoid this property being accidentially used, you have to provide
+-- a Confirmation containing the name of the host that you intend to apply
+-- the property to.
+--
+-- This property only runs once. The cleanly installed system will have
+-- a file </etc/propellor-cleaninstall>, which indicates it was cleanly
+-- installed.
+--
+-- The files from the old os will be left in </old-os>
+--
+-- After the OS is installed, and if all properties of the host have
+-- been successfully satisfied, the host will be rebooted to properly load
+-- the new OS.
+--
+-- You will typically want to run some more properties after the clean
+-- install succeeds, to bootstrap from the cleanly installed system to
+-- a fully working system. For example:
+--
+-- > & osDebian Unstable "amd64"
+-- > & cleanInstallOnce (Confirmed "foo.example.com")
+-- > `onChange` propertyList "fixing up after clean install"
+-- > [ preserveNetwork
+-- > , preserveResolvConf
+-- > , preserveRootSshAuthorized
+-- > , Apt.update
+-- > -- , Grub.boots "/dev/sda"
+-- > -- `requires` Grub.installed Grub.PC
+-- > -- , oldOsRemoved (Confirmed "foo.example.com")
+-- > ]
+-- > & Hostname.sane
+-- > & Apt.installed ["linux-image-amd64"]
+-- > & Apt.installed ["ssh"]
+-- > & User.hasSomePassword "root"
+-- > & User.accountFor "joey"
+-- > & User.hasSomePassword "joey"
+-- > -- rest of system properties here
+cleanInstallOnce :: Confirmation -> Property Linux
+cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
+ go `requires` confirmed "clean install confirmed" confirmation
+ where
+ go =
+ finalized
+ `requires`
+ -- easy to forget and system may not boot without shadow pw!
+ User.shadowConfig True
+ `requires`
+ -- reboot at end if the rest of the propellor run succeeds
+ Reboot.atEnd True (/= FailedChange)
+ `requires`
+ propellorbootstrapped
+ `requires`
+ flipped
+ `requires`
+ osbootstrapped
+
+ osbootstrapped :: Property Linux
+ osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \w o -> case o of
+ (Just d@(System (Debian _) _)) -> ensureProperty w $
+ debootstrap d
+ (Just u@(System (Buntish _) _)) -> ensureProperty w $
+ debootstrap u
+ _ -> unsupportedOS'
+
+ debootstrap :: System -> Property Linux
+ debootstrap targetos =
+ -- Install debootstrap from source, since we don't know
+ -- what OS we're currently running in.
+ Debootstrap.built' Debootstrap.sourceInstall
+ newOSDir targetos Debootstrap.DefaultConfig
+ -- debootstrap, I wish it was faster..
+ -- TODO eatmydata to speed it up
+ -- Problem: Installing eatmydata on some random OS like
+ -- Fedora may be difficult. Maybe configure dpkg to not
+ -- sync instead?
+
+ -- This is the fun bit.
+ flipped :: Property Linux
+ flipped = property (newOSDir ++ " moved into place") $ liftIO $ do
+ -- First, unmount most mount points, lazily, so
+ -- they don't interfere with moving things around.
+ devfstype <- fromMaybe "devtmpfs" <$> getFsType "/dev"
+ mnts <- filter (`notElem` ("/": trickydirs)) <$> mountPoints
+ -- reverse so that deeper mount points come first
+ forM_ (reverse mnts) umountLazy
+
+ renamesout <- map (\d -> (d, oldOSDir ++ d, pure $ d `notElem` (oldOSDir:newOSDir:trickydirs)))
+ <$> dirContents "/"
+ renamesin <- map (\d -> let dest = "/" ++ takeFileName d in (d, dest, not <$> fileExist dest))
+ <$> dirContents newOSDir
+ createDirectoryIfMissing True oldOSDir
+ massRename (renamesout ++ renamesin)
+ removeDirectoryRecursive newOSDir
+
+ -- Prepare environment for running additional properties,
+ -- overriding old OS's environment.
+ void $ setEnv "PATH" stdPATH True
+ void $ unsetEnv "LANG"
+
+ -- Remount /dev, so that block devices etc are
+ -- available for other properties to use.
+ unlessM (mount devfstype devfstype "/dev" mempty) $ do
+ warningMessage $ "failed mounting /dev using " ++ devfstype ++ "; falling back to MAKEDEV generic"
+ void $ boolSystem "sh" [Param "-c", Param "cd /dev && /sbin/MAKEDEV generic"]
+
+ -- Mount /sys too, needed by eg, grub-mkconfig.
+ unlessM (mount "sysfs" "sysfs" "/sys" mempty) $
+ warningMessage "failed mounting /sys"
+
+ -- And /dev/pts, used by apt.
+ unlessM (mount "devpts" "devpts" "/dev/pts" mempty) $
+ warningMessage "failed mounting /dev/pts"
+
+ return MadeChange
+
+ propellorbootstrapped :: Property UnixLike
+ propellorbootstrapped = property "propellor re-debootstrapped in new os" $
+ return NoChange
+ -- re-bootstrap propellor in /usr/local/propellor,
+ -- (using git repo bundle, privdata file, and possibly
+ -- git repo url, which all need to be arranged to
+ -- be present in /old-os's /usr/local/propellor)
+ -- TODO
+
+ finalized :: Property UnixLike
+ finalized = property "clean OS installed" $ do
+ liftIO $ writeFile flagfile ""
+ return MadeChange
+
+ flagfile = "/etc/propellor-cleaninstall"
+
+ trickydirs =
+ -- /tmp can contain X's sockets, which prevent moving it
+ -- so it's left as-is.
+ [ "/tmp"
+ -- /proc is left mounted
+ , "/proc"
+ ]
+
+-- Performs all the renames. If any rename fails, rolls back all
+-- previous renames. Thus, this either successfully performs all
+-- the renames, or does not change the system state at all.
+massRename :: [(FilePath, FilePath, IO Bool)] -> IO ()
+massRename = go []
+ where
+ go _ [] = return ()
+ go undo ((from, to, test):rest) = ifM test
+ ( tryNonAsync (rename from to)
+ >>= either
+ (rollback undo)
+ (const $ go ((to, from):undo) rest)
+ , go undo rest
+ )
+ rollback undo e = do
+ mapM_ (uncurry rename) undo
+ throw e
+
+data Confirmation = Confirmed HostName
+
+confirmed :: Desc -> Confirmation -> Property UnixLike
+confirmed desc (Confirmed c) = property desc $ do
+ hostname <- asks hostName
+ if hostname /= c
+ then do
+ warningMessage "Run with a bad confirmation, not matching hostname."
+ return FailedChange
+ else return NoChange
+
+-- | </etc/network/interfaces> is configured to bring up the network
+-- interface that currently has a default route configured, using
+-- the same (static) IP address.
+preserveNetwork :: Property DebianLike
+preserveNetwork = go `requires` Network.cleanInterfacesFile
+ where
+ go :: Property DebianLike
+ go = property' "preserve network configuration" $ \w -> do
+ ls <- liftIO $ lines <$> readProcess "ip"
+ ["route", "list", "scope", "global"]
+ case words <$> headMaybe ls of
+ Just ("default":"via":_:"dev":iface:_) ->
+ ensureProperty w $ Network.static iface
+ _ -> do
+ warningMessage "did not find any default ipv4 route"
+ return FailedChange
+
+-- | </etc/resolv.conf> is copied from the old OS
+preserveResolvConf :: Property Linux
+preserveResolvConf = check (fileExist oldloc) $
+ property' (newloc ++ " copied from old OS") $ \w -> do
+ ls <- liftIO $ lines <$> readFile oldloc
+ ensureProperty w $ newloc `File.hasContent` ls
+ where
+ newloc = "/etc/resolv.conf"
+ oldloc = oldOSDir ++ newloc
+
+-- | </root/.ssh/authorized_keys> has added to it any ssh keys that
+-- were authorized in the old OS. Any other contents of the file are
+-- retained.
+preserveRootSshAuthorized :: Property UnixLike
+preserveRootSshAuthorized = check (fileExist oldloc) $
+ property' desc $ \w -> do
+ ks <- liftIO $ lines <$> readFile oldloc
+ ensureProperty w $ combineProperties desc $
+ toProps $ map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks
+ where
+ desc = newloc ++ " copied from old OS"
+ newloc = "/root/.ssh/authorized_keys"
+ oldloc = oldOSDir ++ newloc
+
+-- Removes the old OS's backup from </old-os>
+oldOSRemoved :: Confirmation -> Property UnixLike
+oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $
+ go `requires` confirmed "old OS backup removal confirmed" confirmation
+ where
+ go :: Property UnixLike
+ go = property "old OS backup removed" $ do
+ liftIO $ removeDirectoryRecursive oldOSDir
+ return MadeChange
+
+oldOSDir :: FilePath
+oldOSDir = "/old-os"
+
+newOSDir :: FilePath
+newOSDir = "/new-os"
diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs
index 1e7c2c25..5bf3ff06 100644
--- a/src/Propellor/Property/Obnam.hs
+++ b/src/Propellor/Property/Obnam.hs
@@ -1,9 +1,11 @@
+-- | Support for the Obnam backup tool <http://obnam.org/>
+
module Propellor.Property.Obnam where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cron as Cron
-import Utility.SafeCommand
+import qualified Propellor.Property.Gpg as Gpg
import Data.List
@@ -25,41 +27,69 @@ data NumClients = OnlyClient | MultipleClients
--
-- So, this property can be used to deploy a directory of content
-- to a host, while also ensuring any changes made to it get backed up.
--- And since Obnam encrypts, just make this property depend on a gpg
--- key, and tell obnam to use the key, and your data will be backed
--- up securely. For example:
+-- For example:
--
-- > & Obnam.backup "/srv/git" "33 3 * * *"
-- > [ "--repository=sftp://2318@usw-s002.rsync.net/~/mygitrepos.obnam"
--- > , "--encrypt-with=1B169BE1"
-- > ] Obnam.OnlyClient
--- > `requires` Gpg.keyImported "1B169BE1" "root"
-- > `requires` Ssh.keyImported SshRsa "root" (Context hostname)
--
-- How awesome is that?
-backup :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property
-backup dir crontimes params numclients = backup' dir crontimes params numclients
- `requires` restored dir params
+--
+-- Note that this property does not make obnam encrypt the backup
+-- repository.
+--
+-- Since obnam uses a fair amount of system resources, only one obnam
+-- backup job will be run at a time. Other jobs will wait their turns to
+-- run.
+backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike
+backup dir crontimes params numclients =
+ backup' dir crontimes params numclients
+ `requires` restored dir params
+
+-- | Like backup, but the specified gpg key id is used to encrypt
+-- the repository.
+--
+-- The gpg secret key will be automatically imported
+-- into root's keyring using Propellor.Property.Gpg.keyImported
+backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property (HasInfo + DebianLike)
+backupEncrypted dir crontimes params numclients keyid =
+ backup dir crontimes params' numclients
+ `requires` Gpg.keyImported keyid (User "root")
+ where
+ params' = ("--encrypt-with=" ++ Gpg.getGpgKeyId keyid) : params
-- | Does a backup, but does not automatically restore.
-backup' :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property
+backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike
backup' dir crontimes params numclients = cronjob `describe` desc
where
desc = dir ++ " backed up by obnam"
- cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes "root" "/" $
- intercalate ";" $ catMaybes
- [ if numclients == OnlyClient
- then Just $ unwords $
- [ "obnam"
- , "force-lock"
- ] ++ map shellEscape params
- else Nothing
- , Just $ unwords $
- [ "obnam"
- , "backup"
- , shellEscape dir
- ] ++ map shellEscape params
- ]
+ cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes (User "root") "/" $
+ "flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape cmdline
+ lockfile = "/var/lock/propellor-obnam.lock"
+ cmdline = unwords $ catMaybes
+ [ if numclients == OnlyClient
+ -- forcelock fails if repo does not exist yet
+ then Just $ forcelockcmd ++ " 2>/dev/null ;"
+ else Nothing
+ , Just backupcmd
+ , if any isKeepParam params
+ then Just $ "&& " ++ forgetcmd
+ else Nothing
+ ]
+ forcelockcmd = unwords $
+ [ "obnam"
+ , "force-lock"
+ ] ++ map shellEscape params
+ backupcmd = unwords $
+ [ "obnam"
+ , "backup"
+ , shellEscape dir
+ ] ++ map shellEscape params
+ forgetcmd = unwords $
+ [ "obnam"
+ , "forget"
+ ] ++ map shellEscape params
-- | Restores a directory from an obnam backup.
--
@@ -68,11 +98,12 @@ backup' dir crontimes params numclients = cronjob `describe` desc
--
-- The restore is performed atomically; restoring to a temp directory
-- and then moving it to the directory.
-restored :: FilePath -> [ObnamParam] -> Property
-restored dir params = property (dir ++ " restored by obnam") go
- `requires` installed
+restored :: FilePath -> [ObnamParam] -> Property DebianLike
+restored dir params = go `requires` installed
where
- go = ifM (liftIO needsRestore)
+ desc = dir ++ " restored by obnam"
+ go :: Property DebianLike
+ go = property desc $ ifM (liftIO needsRestore)
( do
warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
liftIO restore
@@ -96,64 +127,33 @@ restored dir params = property (dir ++ " restored by obnam") go
, return FailedChange
)
-installed :: Property
-installed = Apt.installed ["obnam"]
+-- | Policy for backup generations to keep. For example, KeepDays 30 will
+-- keep the latest backup for each day when a backup was made, and keep the
+-- last 30 such backups. When multiple KeepPolicies are combined together,
+-- backups meeting any policy are kept. See obnam's man page for details.
+data KeepPolicy
+ = KeepHours Int
+ | KeepDays Int
+ | KeepWeeks Int
+ | KeepMonths Int
+ | KeepYears Int
--- | Ensures that a recent version of obnam gets installed.
---
--- Only does anything for Debian Stable.
-latestVersion :: Property
-latestVersion = withOS "obnam latest version" $ \o -> case o of
- (Just (System (Debian suite) _)) | isStable suite -> ensureProperty $
- Apt.setSourcesListD (stablesources suite) "obnam"
- `requires` toProp (Apt.trustsKey key)
- _ -> noChange
+-- | Constructs an ObnamParam that specifies which old backup generations
+-- to keep. By default, all generations are kept. However, when this parameter
+-- is passed to the `backup` or `backupEncrypted` properties, they will run
+-- obnam forget to clean out generations not specified here.
+keepParam :: [KeepPolicy] -> ObnamParam
+keepParam ps = "--keep=" ++ intercalate "," (map go ps)
where
- stablesources suite =
- [ "deb http://code.liw.fi/debian " ++ Apt.showSuite suite ++ " main"
- ]
- -- gpg key used by the code.liw.fi repository.
- key = Apt.AptKey "obnam" $ unlines
- [ "-----BEGIN PGP PUBLIC KEY BLOCK-----"
- , "Version: GnuPG v1.4.9 (GNU/Linux)"
- , ""
- , "mQGiBEfzuTgRBACcVNG/H6QJqLx5qiQs2zmPe6D6BWOWHfgNgG4IWzNstm21YDxb"
- , "KqwFG0gxcnZJGHkXAhkSfqTokYd0lc5eBemcA1pkceNjzMEX8wwiZ810HzJD4eEH"
- , "sjoWR8+qKrZeixzZqReAfqztcXoBGKQ0u1R1vpg1txUa75OM4BUqaUbsmwCgmS4x"
- , "DjMxSaUSPuu6vQ7ZGZBXSP0D/RQw8DBHMfsv3DiaqFqk8tkuUkpMFPIekHidSHlO"
- , "EACbncqbbyHksyCpFNVNcQIDHrOLjOZK9BAXkSd8I3ww7U+nLdDcCblrW8CZnJtm"
- , "ZYrxfaXaHZ/It9/RCAsQ+c8xtmyUPjsf//4Vf8olxNQHzgBSe5/LJRi4Vd53he+K"
- , "YP4LA/9IZbjvVmm8+8Y0pQrTHlI6nTImtzdBXHc4+T3lLBj9XODHLozC2kSBOQky"
- , "q/EisTITHTXL8vYg4NsKm5RTbPAuBwdtxcny8CXfOqKtGOdrebmKotGllTozzdPv"
- , "9p53cuce6oJ2oMUodc074JOGTWwDSgLiJX4nViGcU1wy/vtQnrQkY29kZS5saXcu"
- , "ZmkgYXJjaGl2ZSBrZXkgPGxpd0BsaXcuZmk+iGAEExECACAFAkfzuTgCGwMGCwkI"
- , "BwMCBBUCCAMEFgIDAQIeAQIXgAAKCRBG53tJR95LscKrAJ0ZtKqa2x6Kplwa2mzx"
- , "ItImbIGMJACdETqofDYzUN91yLAFlOnxAyrE+UyIRgQQEQIABgUCSFd5GgAKCRAf"
- , "u5W/LZrMjqr8AJ4xPVHpW8ZNlgMwDSVb075RnA2DiACgg2SR69jAHFQOWV6xfLRr"
- , "vh0bLKGJAhwEEAEIAAYFAktEyIwACgkQ61zh116FEfm7Lg//Wiy3TjWAk8YHUddv"
- , "zOioYzCxQ985GsVhJGAVPqSGOc9vfTWBJZ8J3l0NnYTRpEGucmbF9G+mAt9iGXu6"
- , "7yZkxyFdvbo7EDsqMU1wLOM6PiU+Un63MKlbTNmFn7OKE8aXPRAFgcyUO/qjdqoD"
- , "sa9FgU5Z0f60m9qah6BPXH6IzMLHYoiP7t8rCBIwLgyl3w2w+Fjt1DFpbW9Kb7jz"
- , "i8jFvC8jPmxV8xh2OSgVZyNk4qg6hIV8GVQY7AJt8OurZSckgQd7ifHK9JTGohtF"
- , "tXCiqeDEvnMF4A9HI/TcXJBzonZ8ds1JCq42nSSKmL+8TyjtUSD/xHygazuc0CK0"
- , "hFnQWBub60IfyV6F0oTagJ8cmARv2sezHAeHDkzPHE8RdjgktazH1eJrA4LheEd6"
- , "KeSnVtYWpw8dgMv5PleFyQiAj/t3C/N50fd15tUyfnH15G7nFjMQV2Yx35uwSxOj"
- , "376OWnDN/YGTNk283XXULbyVJYR8Q2unso20XQ94yQ2A5EpHHPrHoLxrL/ydM08d"
- , "nvKstLZIZtal1seiMkymtlSiGz25A5oqsclwS6VZCKdWA8HO/wlElOMcaHyl6Y1y"
- , "gYP7y9O5yFYKFOrCH0nFjJbwmkRiBLsxuuWsYgJigVGq/atSrtawkHdshpCw0HCY"
- , "N/RFcWkJ864BdsO0C0sDzueNkQO5Ag0ER/O5RBAIAJiwPH9tyJTgXcC2Y4XWboOq"
- , "rx5CkOnr5b45oS9cK2eIJ8TKxE3XgKLxUr3mIH0QR2kZgDOwNl0WY+7/CXjn+Spn"
- , "BokPg54rafEUePodGpGdUXdgrHhAMHYjh8fXFJ1SlQcg46/zc1wDI7jBCkGrK3V8"
- , "5cXDqwTFTN5LcjoSRWeM4Voa6pEfDdL3rMlnOw9R9gDHRBBb6CDSjWXqM86pR889"
- , "5QrR0SDwiJNrMoyxSjMXFKGBQAsYHJ82myZrlbuZbroZjVp5Uh7eB1ZiPljNVtcr"
- , "sksACIWBCo1rvLzrPXsLYOeV3cDDtYAkSwGfuzC1Etbe+qgfIroFTOqdefMw4s8A"
- , "AwUH/0KLXm4MS54QQspg3evu4Q4U/E8Hem5/FqB0GhBCitQ4rUsucKyY8/ItpUn5"
- , "ismLE60bQqka+Mzd/Zw18TCTzImv0ozAaZ2sNtBado7f6jcC8EDfY5zzK1ukcsAr"
- , "Qc5hdLHYuTQW5KpA6fKaW969OUzIwPbdVaCOLOBpxKC6N6iBspQYd6uiQtLw6EUO"
- , "50oQqUiJABf0eOocvdw5e2KQQpuC3205+VMYtyl4w3pdJihK8NK0AikGXzDVsbQt"
- , "l8kmB5ZrN4WIKhMke1FxbqQC5Q3XATvYRzpzzisZb/HYGNti8W6du5EUwJ0D2NRh"
- , "cu+twocOzW0VKfmrDApfifJ9OsSISQQYEQIACQUCR/O5RAIbDAAKCRBG53tJR95L"
- , "seQOAJ95KUyzjRjdYgZkDC69Mgu25L86UACdGduINUaRly43ag4kwUXxpqswBBM="
- , "=i2c3"
- , "-----END PGP PUBLIC KEY BLOCK-----"
- ]
+ go (KeepHours n) = mk n 'h'
+ go (KeepDays n) = mk n 'd'
+ go (KeepWeeks n) = mk n 'w'
+ go (KeepMonths n) = mk n 'm'
+ go (KeepYears n) = mk n 'y'
+ mk n c = show n ++ [c]
+
+isKeepParam :: ObnamParam -> Bool
+isKeepParam p = "--keep=" `isPrefixOf` p
+
+installed :: Property DebianLike
+installed = Apt.installed ["obnam"]
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index 39cb6ff0..0abf38a6 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -1,30 +1,50 @@
module Propellor.Property.OpenId where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
-import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.Apache as Apache
import Data.List
-providerFor :: [UserName] -> String -> Property
-providerFor users baseurl = propertyList desc $
- [ Apt.serviceInstalledRunning "apache2"
- , Apt.installed ["simpleid"]
- `onChange` Service.restarted "apache2"
- , File.fileProperty (desc ++ " configured")
+-- | Openid provider, using the simpleid PHP CGI, with apache.
+--
+-- Runs on usual port by default. When a nonstandard port is specified,
+-- apache is limited to listening only on that port. Warning: Specifying
+-- a port won't compose well with other apache properties on the same
+-- host.
+--
+-- It's probably a good idea to put this property inside a docker or
+-- systemd-nspawn container.
+providerFor :: [User] -> HostName -> Maybe Port -> Property (HasInfo + DebianLike)
+providerFor users hn mp = propertyList desc $ props
+ & Apt.serviceInstalledRunning "apache2"
+ & apacheconfigured
+ & Apt.installed ["simpleid"]
+ `onChange` Apache.restarted
+ & File.fileProperty (desc ++ " configured")
(map setbaseurl) "/etc/simpleid/config.inc"
- ] ++ map identfile users
+ & propertyList desc (toProps $ map identfile users)
where
+ baseurl = hn ++ case mp of
+ Nothing -> ""
+ Just p -> ':' : fromPort p
url = "http://"++baseurl++"/simpleid"
desc = "openid provider " ++ url
setbaseurl l
- | "SIMPLEID_BASE_URL" `isInfixOf` l =
+ | "SIMPLEID_BASE_URL" `isInfixOf` l =
"define('SIMPLEID_BASE_URL', '"++url++"');"
| otherwise = l
-
- -- the identitites directory controls access, so open up
+
+ apacheconfigured = case mp of
+ Nothing -> setupRevertableProperty $
+ Apache.virtualHost hn (Port 80) "/var/www/html"
+ Just p -> propertyList desc $ props
+ & Apache.listenPorts [p]
+ & Apache.virtualHost hn p "/var/www/html"
+
+ -- the identities directory controls access, so open up
-- file mode
- identfile u = File.hasPrivContentExposed
+ identfile (User u) = File.hasPrivContentExposed
(concat [ "/var/lib/simpleid/identities/", u, ".identity" ])
(Context baseurl)
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
new file mode 100644
index 00000000..bc8a256d
--- /dev/null
+++ b/src/Propellor/Property/Parted.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Propellor.Property.Parted (
+ TableType(..),
+ PartTable(..),
+ partTableSize,
+ Partition(..),
+ mkPartition,
+ Partition.Fs(..),
+ PartSize(..),
+ ByteSize,
+ toPartSize,
+ fromPartSize,
+ reducePartSize,
+ Partition.MkfsOpts,
+ PartType(..),
+ PartFlag(..),
+ Eep(..),
+ partitioned,
+ parted,
+ installed,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Partition as Partition
+import Utility.DataUnits
+import Data.Char
+import System.Posix.Files
+
+class PartedVal a where
+ val :: a -> String
+
+-- | Types of partition tables supported by parted.
+data TableType = MSDOS | GPT | AIX | AMIGA | BSD | DVH | LOOP | MAC | PC98 | SUN
+ deriving (Show)
+
+instance PartedVal TableType where
+ val = map toLower . show
+
+-- | A disk's partition table.
+data PartTable = PartTable TableType [Partition]
+ deriving (Show)
+
+instance Monoid PartTable where
+ -- | default TableType is MSDOS
+ mempty = PartTable MSDOS []
+ -- | uses the TableType of the second parameter
+ mappend (PartTable _l1 ps1) (PartTable l2 ps2) = PartTable l2 (ps1 ++ ps2)
+
+-- | Gets the total size of the disk specified by the partition table.
+partTableSize :: PartTable -> ByteSize
+partTableSize (PartTable _ ps) = fromPartSize $
+ -- add 1 megabyte to hold the partition table itself
+ mconcat (MegaBytes 1 : map partSize ps)
+
+-- | A partition on the disk.
+data Partition = Partition
+ { partType :: PartType
+ , partSize :: PartSize
+ , partFs :: Partition.Fs
+ , partMkFsOpts :: Partition.MkfsOpts
+ , partFlags :: [(PartFlag, Bool)] -- ^ flags can be set or unset (parted may set some flags by default)
+ , partName :: Maybe String -- ^ optional name for partition (only works for GPT, PC98, MAC)
+ }
+ deriving (Show)
+
+-- | Makes a Partition with defaults for non-important values.
+mkPartition :: Partition.Fs -> PartSize -> Partition
+mkPartition fs sz = Partition
+ { partType = Primary
+ , partSize = sz
+ , partFs = fs
+ , partMkFsOpts = []
+ , partFlags = []
+ , partName = Nothing
+ }
+
+-- | Type of a partition.
+data PartType = Primary | Logical | Extended
+ deriving (Show)
+
+instance PartedVal PartType where
+ val Primary = "primary"
+ val Logical = "logical"
+ val Extended = "extended"
+
+-- | All partition sizing is done in megabytes, so that parted can
+-- automatically lay out the partitions.
+--
+-- Note that these are SI megabytes, not mebibytes.
+newtype PartSize = MegaBytes Integer
+ deriving (Show)
+
+instance PartedVal PartSize where
+ val (MegaBytes n)
+ | n > 0 = show n ++ "MB"
+ -- parted can't make partitions smaller than 1MB;
+ -- avoid failure in edge cases
+ | otherwise = show "1MB"
+
+-- | Rounds up to the nearest MegaByte.
+toPartSize :: ByteSize -> PartSize
+toPartSize b = MegaBytes $ ceiling (fromInteger b / 1000000 :: Double)
+
+fromPartSize :: PartSize -> ByteSize
+fromPartSize (MegaBytes b) = b * 1000000
+
+instance Monoid PartSize where
+ mempty = MegaBytes 0
+ mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b)
+
+reducePartSize :: PartSize -> PartSize -> PartSize
+reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)
+
+-- | Flags that can be set on a partition.
+data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag
+ deriving (Show)
+
+instance PartedVal PartFlag where
+ val BootFlag = "boot"
+ val RootFlag = "root"
+ val SwapFlag = "swap"
+ val HiddenFlag = "hidden"
+ val RaidFlag = "raid"
+ val LvmFlag = "lvm"
+ val LbaFlag = "lba"
+ val LegacyBootFlag = "legacy_boot"
+ val IrstFlag = "irst"
+ val EspFlag = "esp"
+ val PaloFlag = "palo"
+
+instance PartedVal Bool where
+ val True = "on"
+ val False = "off"
+
+instance PartedVal Partition.Fs where
+ val Partition.EXT2 = "ext2"
+ val Partition.EXT3 = "ext3"
+ val Partition.EXT4 = "ext4"
+ val Partition.BTRFS = "btrfs"
+ val Partition.REISERFS = "reiserfs"
+ val Partition.XFS = "xfs"
+ val Partition.FAT = "fat"
+ val Partition.VFAT = "vfat"
+ val Partition.NTFS = "ntfs"
+ val Partition.LinuxSwap = "linux-swap"
+
+data Eep = YesReallyDeleteDiskContents
+
+-- | Partitions a disk using parted, and formats the partitions.
+--
+-- The FilePath can be a block device (eg, \/dev\/sda), or a disk image file.
+--
+-- This deletes any existing partitions in the disk! Use with EXTREME caution!
+partitioned :: Eep -> FilePath -> PartTable -> Property DebianLike
+partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do
+ isdev <- liftIO $ isBlockDevice <$> getFileStatus disk
+ ensureProperty w $ combineProperties desc $ props
+ & parted eep disk partedparams
+ & if isdev
+ then formatl (map (\n -> disk ++ show n) [1 :: Int ..])
+ else Partition.kpartx disk (formatl . map Partition.partitionLoopDev)
+ where
+ desc = disk ++ " partitioned"
+ formatl devs = combineProperties desc (toProps $ map format (zip parts devs))
+ partedparams = concat $ mklabel : mkparts (1 :: Integer) mempty parts []
+ format (p, dev) = Partition.formatted' (partMkFsOpts p)
+ Partition.YesReallyFormatPartition (partFs p) dev
+ mklabel = ["mklabel", val tabletype]
+ mkflag partnum (f, b) =
+ [ "set"
+ , show partnum
+ , val f
+ , val b
+ ]
+ mkpart partnum offset p =
+ [ "mkpart"
+ , val (partType p)
+ , val (partFs p)
+ , val offset
+ , val (offset <> partSize p)
+ ] ++ case partName p of
+ Just n -> ["name", show partnum, n]
+ Nothing -> []
+ mkparts partnum offset (p:ps) c =
+ mkparts (partnum+1) (offset <> partSize p) ps
+ (c ++ mkpart partnum offset p : map (mkflag partnum) (partFlags p))
+ mkparts _ _ [] c = c
+
+-- | Runs parted on a disk with the specified parameters.
+--
+-- Parted is run in script mode, so it will never prompt for input.
+-- It is asked to use cylinder alignment for the disk.
+parted :: Eep -> FilePath -> [String] -> Property DebianLike
+parted YesReallyDeleteDiskContents disk ps = p `requires` installed
+ where
+ p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps)
+ `assume` MadeChange
+
+-- | Gets parted installed.
+installed :: Property DebianLike
+installed = Apt.installed ["parted"]
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
new file mode 100644
index 00000000..2bf5b927
--- /dev/null
+++ b/src/Propellor/Property/Partition.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Propellor.Property.Partition where
+
+import Propellor.Base
+import Propellor.Types.Core
+import qualified Propellor.Property.Apt as Apt
+import Utility.Applicative
+
+import System.Posix.Files
+import Data.List
+
+-- | Filesystems etc that can be used for a partition.
+data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap
+ deriving (Show, Eq)
+
+data Eep = YesReallyFormatPartition
+
+-- | Formats a partition.
+formatted :: Eep -> Fs -> FilePath -> Property DebianLike
+formatted = formatted' []
+
+-- | Options passed to a mkfs.* command when making a filesystem.
+--
+-- Eg, ["-m0"]
+type MkfsOpts = [String]
+
+formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property DebianLike
+formatted' opts YesReallyFormatPartition fs dev = cmdProperty cmd opts'
+ `assume` MadeChange
+ `requires` Apt.installed [pkg]
+ where
+ (cmd, opts', pkg) = case fs of
+ EXT2 -> ("mkfs.ext2", q $ eff optsdev, "e2fsprogs")
+ EXT3 -> ("mkfs.ext3", q $ eff optsdev, "e2fsprogs")
+ EXT4 -> ("mkfs.ext4", q $ eff optsdev, "e2fsprogs")
+ BTRFS -> ("mkfs.btrfs", optsdev, "btrfs-tools")
+ REISERFS -> ("mkfs.reiserfs", q $ "-ff":optsdev, "reiserfsprogs")
+ XFS -> ("mkfs.xfs", "-f":q optsdev, "xfsprogs")
+ FAT -> ("mkfs.fat", optsdev, "dosfstools")
+ VFAT -> ("mkfs.vfat", optsdev, "dosfstools")
+ NTFS -> ("mkfs.ntfs", q $ eff optsdev, "ntfs-3g")
+ LinuxSwap -> ("mkswap", optsdev, "util-linux")
+ optsdev = opts++[dev]
+ -- -F forces creating a filesystem even if the device already has one
+ eff l = "-F":l
+ -- Be quiet.
+ q l = "-q":l
+
+data LoopDev = LoopDev
+ { partitionLoopDev :: FilePath -- ^ device for a loop partition
+ , wholeDiskLoopDev :: FilePath -- ^ corresponding device for the whole loop disk
+ } deriving (Show)
+
+isLoopDev :: LoopDev -> IO Bool
+isLoopDev l = isLoopDev' (partitionLoopDev l) <&&> isLoopDev' (wholeDiskLoopDev l)
+
+isLoopDev' :: FilePath -> IO Bool
+isLoopDev' f
+ | "loop" `isInfixOf` f = catchBoolIO $
+ isBlockDevice <$> getFileStatus f
+ | otherwise = return False
+
+-- | Uses the kpartx utility to create device maps for partitions contained
+-- within a disk image file. The resulting loop devices are passed to the
+-- property, which can operate on them. Always cleans up after itself,
+-- by removing the device maps after the property is run.
+kpartx :: FilePath -> ([LoopDev] -> Property DebianLike) -> Property DebianLike
+kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"]
+ where
+ go :: Property DebianLike
+ go = property' (getDesc (mkprop [])) $ \w -> do
+ cleanup -- idempotency
+ loopdevs <- liftIO $ kpartxParse
+ <$> readProcess "kpartx" ["-avs", diskimage]
+ bad <- liftIO $ filterM (not <$$> isLoopDev) loopdevs
+ unless (null bad) $
+ error $ "kpartx output seems to include non-loop-devices (possible parse failure): " ++ show bad
+ r <- ensureProperty w (mkprop loopdevs)
+ cleanup
+ return r
+ cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage]
+
+kpartxParse :: String -> [LoopDev]
+kpartxParse = mapMaybe (finddev . words) . lines
+ where
+ finddev ("add":"map":ld:_:_:_:_:wd:_) = Just $ LoopDev
+ { partitionLoopDev = "/dev/mapper/" ++ ld
+ , wholeDiskLoopDev = wd
+ }
+ finddev _ = Nothing
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index b3d12727..45aa4e42 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -1,73 +1,83 @@
+{-# LANGUAGE FlexibleContexts #-}
+
module Propellor.Property.Postfix where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
-import Propellor.Property.File
+import qualified Propellor.Property.File as File
import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.User as User
import qualified Data.Map as M
import Data.List
import Data.Char
-installed :: Property
+installed :: Property DebianLike
installed = Apt.serviceInstalledRunning "postfix"
-restarted :: Property
+restarted :: Property DebianLike
restarted = Service.restarted "postfix"
-reloaded :: Property
+reloaded :: Property DebianLike
reloaded = Service.reloaded "postfix"
-- | Configures postfix as a satellite system, which
--- relays all mail through a relay host, which defaults to smtp.domain.
+-- relays all mail through a relay host, which defaults to smtp.domain,
+-- but can be changed by @mainCf "relayhost"@.
--
-- The smarthost may refuse to relay mail on to other domains, without
--- futher coniguration/keys. But this should be enough to get cron job
+-- further configuration/keys. But this should be enough to get cron job
-- mail flowing to a place where it will be seen.
-satellite :: Property
+satellite :: Property DebianLike
satellite = check (not <$> mainCfIsSet "relayhost") setup
`requires` installed
where
- setup = trivial $ property "postfix satellite system" $ do
+ desc = "postfix satellite system"
+ setup :: Property DebianLike
+ setup = property' desc $ \w -> do
hn <- asks hostName
let (_, domain) = separate (== '.') hn
- ensureProperties
- [ Apt.reConfigure "postfix"
+ ensureProperty w $ combineProperties desc $ props
+ & Apt.reConfigure "postfix"
[ ("postfix/main_mailer_type", "select", "Satellite system")
, ("postfix/root_address", "string", "root")
- , ("postfix/destinations", "string", " ")
+ , ("postfix/destinations", "string", "localhost")
, ("postfix/mailname", "string", hn)
]
- , mainCf ("relayhost", domain)
+ & mainCf ("relayhost", "smtp." ++ domain)
`onChange` reloaded
- ]
-- | Sets up a file by running a property (which the filename is passed
-- to). If the setup property makes a change, postmap will be run on the
-- file, and postfix will be reloaded.
-mappedFile :: FilePath -> (FilePath -> Property) -> Property
+mappedFile
+ :: Combines (Property x) (Property UnixLike)
+ => FilePath
+ -> (FilePath -> Property x)
+ -> CombinedType (Property x) (Property UnixLike)
mappedFile f setup = setup f
- `onChange` cmdProperty "postmap" [f]
+ `onChange` (cmdProperty "postmap" [f] `assume` MadeChange)
-- | Run newaliases command, which should be done after changing
--- /etc/aliases.
-newaliases :: Property
-newaliases = trivial $ cmdProperty "newaliases" []
+-- @/etc/aliases@.
+newaliases :: Property UnixLike
+newaliases = check ("/etc/aliases" `isNewerThan` "/etc/aliases.db")
+ (cmdProperty "newaliases" [])
-- | The main config file for postfix.
mainCfFile :: FilePath
mainCfFile = "/etc/postfix/main.cf"
--- | Sets a main.cf name=value pair. Does not reload postfix immediately.
-mainCf :: (String, String) -> Property
+-- | Sets a main.cf @name=value@ pair. Does not reload postfix immediately.
+mainCf :: (String, String) -> Property UnixLike
mainCf (name, value) = check notset set
- `describe` ("postfix main.cf " ++ setting)
+ `describe` ("postfix main.cf " ++ setting)
where
setting = name ++ "=" ++ value
notset = (/= Just value) <$> getMainCf name
set = cmdProperty "postconf" ["-e", setting]
--- | Gets a man.cf setting.
+-- | Gets a main.cf setting.
getMainCf :: String -> IO (Maybe String)
getMainCf name = parse . lines <$> readProcess "postconf" [name]
where
@@ -77,8 +87,8 @@ getMainCf name = parse . lines <$> readProcess "postconf" [name]
(_, v) -> v
parse [] = Nothing
--- | Checks if a main.cf field is set. A field that is set to ""
--- is considered not set.
+-- | Checks if a main.cf field is set. A field that is set to
+-- the empty string is considered not set.
mainCfIsSet :: String -> IO Bool
mainCfIsSet name = do
v <- getMainCf name
@@ -96,8 +106,8 @@ mainCfIsSet name = do
--
-- Note that multiline configurations that continue onto the next line
-- are not currently supported.
-dedupMainCf :: Property
-dedupMainCf = fileProperty "postfix main.cf dedupped" dedupCf mainCfFile
+dedupMainCf :: Property UnixLike
+dedupMainCf = File.fileProperty "postfix main.cf dedupped" dedupCf mainCfFile
dedupCf :: [String] -> [String]
dedupCf ls =
@@ -119,3 +129,193 @@ dedupCf ls =
dedup c kc ((Right (k, v)):rest) = case M.lookup k kc of
Just n | n > 1 -> dedup c (M.insert k (n - 1) kc) rest
_ -> dedup (fmt k v:c) kc rest
+
+-- | The master config file for postfix.
+masterCfFile :: FilePath
+masterCfFile = "/etc/postfix/master.cf"
+
+-- | A service that can be present in the master config file.
+data Service = Service
+ { serviceType :: ServiceType
+ , serviceCommand :: String
+ , serviceOpts :: ServiceOpts
+ }
+ deriving (Show, Eq)
+
+data ServiceType
+ = InetService (Maybe HostName) ServicePort
+ | UnixService FilePath PrivateService
+ | FifoService FilePath PrivateService
+ | PassService FilePath PrivateService
+ deriving (Show, Eq)
+
+-- Can be a port number or service name such as "smtp".
+type ServicePort = String
+
+type PrivateService = Bool
+
+-- | Options for a service.
+data ServiceOpts = ServiceOpts
+ { serviceUnprivileged :: Maybe Bool
+ , serviceChroot :: Maybe Bool
+ , serviceWakeupTime :: Maybe Int
+ , serviceProcessLimit :: Maybe Int
+ }
+ deriving (Show, Eq)
+
+defServiceOpts :: ServiceOpts
+defServiceOpts = ServiceOpts
+ { serviceUnprivileged = Nothing
+ , serviceChroot = Nothing
+ , serviceWakeupTime = Nothing
+ , serviceProcessLimit = Nothing
+ }
+
+formatServiceLine :: Service -> File.Line
+formatServiceLine s = unwords $ map pad
+ [ (10, case serviceType s of
+ InetService (Just h) p -> h ++ ":" ++ p
+ InetService Nothing p -> p
+ UnixService f _ -> f
+ FifoService f _ -> f
+ PassService f _ -> f)
+ , (6, case serviceType s of
+ InetService _ _ -> "inet"
+ UnixService _ _ -> "unix"
+ FifoService _ _ -> "fifo"
+ PassService _ _ -> "pass")
+ , (8, case serviceType s of
+ InetService _ _ -> bool False
+ UnixService _ b -> bool b
+ FifoService _ b -> bool b
+ PassService _ b -> bool b)
+ , (8, v bool serviceUnprivileged)
+ , (8, v bool serviceChroot)
+ , (8, v show serviceWakeupTime)
+ , (8, v show serviceProcessLimit)
+ , (0, serviceCommand s)
+ ]
+ where
+ v f sel = maybe "-" f (sel (serviceOpts s))
+ bool True = "y"
+ bool False = "n"
+ pad (n, t) = t ++ replicate (n - 1 - length t) ' '
+
+-- | Note that this does not handle multi-line service entries,
+-- in which subsequent lines are indented. `serviceLine` does not generate
+-- such entries.
+parseServiceLine :: File.Line -> Maybe Service
+parseServiceLine ('#':_) = Nothing
+parseServiceLine (' ':_) = Nothing -- continuation of multiline entry
+parseServiceLine l = Service
+ <$> parsetype
+ <*> parsecommand
+ <*> parseopts
+ where
+ parsetype = do
+ t <- getword 2
+ case t of
+ "inet" -> do
+ v <- getword 1
+ let (h,p) = separate (== ':') v
+ if null p
+ then Nothing
+ else Just $ InetService
+ (if null h then Nothing else Just h) p
+ "unix" -> UnixService <$> getword 1 <*> parseprivate
+ "fifo" -> FifoService <$> getword 1 <*> parseprivate
+ "pass" -> PassService <$> getword 1 <*> parseprivate
+ _ -> Nothing
+ parseprivate = join . bool =<< getword 3
+
+ parsecommand = case unwords (drop 7 ws) of
+ "" -> Nothing
+ s -> Just s
+
+ parseopts = ServiceOpts
+ <$> (bool =<< getword 4)
+ <*> (bool =<< getword 5)
+ <*> (int =<< getword 6)
+ <*> (int =<< getword 7)
+
+ bool "-" = Just Nothing
+ bool "y" = Just (Just True)
+ bool "n" = Just (Just False)
+ bool _ = Nothing
+
+ int "-" = Just Nothing
+ int n = maybe Nothing (Just . Just) (readish n)
+
+ getword n
+ | nws >= n = Just (ws !! (n -1))
+ | otherwise = Nothing
+ ws = words l
+ nws = length ws
+
+-- | Enables a `Service` in postfix's `masterCfFile`.
+service :: Service -> RevertableProperty DebianLike DebianLike
+service s = (enable <!> disable)
+ `describe` desc
+ where
+ desc = "enabled postfix service " ++ show (serviceType s)
+ enable = masterCfFile `File.containsLine` (formatServiceLine s)
+ `onChange` reloaded
+ disable = File.fileProperty desc (filter (not . matches)) masterCfFile
+ `onChange` reloaded
+ matches l = case parseServiceLine l of
+ Just s' | s' == s -> True
+ _ -> False
+
+-- | Installs saslauthd and configures it for postfix, authenticating
+-- against PAM.
+--
+-- Does not configure postfix to use it; eg @smtpd_sasl_auth_enable = yes@
+-- needs to be set to enable use. See
+-- <https://wiki.debian.org/PostfixAndSASL>.
+--
+-- Password brute force attacks are possible when SASL auth is enabled.
+-- It would be wise to enable fail2ban, for example:
+--
+-- > Fail2Ban.jailEnabled "postfix-sasl"
+saslAuthdInstalled :: Property DebianLike
+saslAuthdInstalled = setupdaemon
+ `requires` Service.running "saslauthd"
+ `requires` postfixgroup
+ `requires` dirperm
+ `requires` Apt.installed ["sasl2-bin"]
+ `requires` smtpdconf
+ where
+ setupdaemon = "/etc/default/saslauthd" `File.containsLines`
+ [ "START=yes"
+ , "OPTIONS=\"-c -m " ++ dir ++ "\""
+ ]
+ `onChange` Service.restarted "saslauthd"
+ smtpdconf = "/etc/postfix/sasl/smtpd.conf" `File.containsLines`
+ [ "pwcheck_method: saslauthd"
+ , "mech_list: PLAIN LOGIN"
+ ]
+ dirperm = check (not <$> doesDirectoryExist dir) $
+ cmdProperty "dpkg-statoverride"
+ [ "--add", "root", "sasl", "710", dir ]
+ postfixgroup = (User "postfix") `User.hasGroup` (Group "sasl")
+ `onChange` restarted
+ dir = "/var/spool/postfix/var/run/saslauthd"
+
+-- | Uses `saslpasswd2` to set the password for a user in the sasldb2 file.
+--
+-- The password is taken from the privdata.
+saslPasswdSet :: Domain -> User -> Property (HasInfo + UnixLike)
+saslPasswdSet domain (User user) = go `changesFileContent` "/etc/sasldb2"
+ where
+ go = withPrivData src ctx $ \getpw ->
+ property desc $ getpw $ \pw -> liftIO $
+ withHandle StdinHandle createProcessSuccess p $ \h -> do
+ hPutStrLn h (privDataVal pw)
+ hClose h
+ return NoChange
+ desc = "sasl password for " ++ uatd
+ uatd = user ++ "@" ++ domain
+ ps = ["-p", "-c", "-u", domain, user]
+ p = proc "saslpasswd2" ps
+ ctx = Context "sasl"
+ src = PrivDataSource (Password uatd) "enter password"
diff --git a/src/Propellor/Property/PropellorRepo.hs b/src/Propellor/Property/PropellorRepo.hs
new file mode 100644
index 00000000..e60e7848
--- /dev/null
+++ b/src/Propellor/Property/PropellorRepo.hs
@@ -0,0 +1,19 @@
+module Propellor.Property.PropellorRepo where
+
+import Propellor.Base
+import Propellor.Git.Config
+
+-- | Sets the url to use as the origin of propellor's git repository.
+--
+-- When propellor --spin is used to update a host, the url is taken from
+-- the repository that --spin is run in, and passed to the host. So, you
+-- don't need to specifiy this property then.
+--
+-- This property is useful when hosts are being updated without using
+-- --spin, eg when using the `Propellor.Property.Cron.runPropellor` cron job.
+hasOriginUrl :: String -> Property UnixLike
+hasOriginUrl u = property ("propellor repo url " ++ u) $ do
+ curru <- liftIO getRepoUrl
+ if curru == Just u
+ then return NoChange
+ else makeChange $ setRepoUrl u
diff --git a/src/Propellor/Property/Prosody.hs b/src/Propellor/Property/Prosody.hs
new file mode 100644
index 00000000..8017be4a
--- /dev/null
+++ b/src/Propellor/Property/Prosody.hs
@@ -0,0 +1,51 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+
+module Propellor.Property.Prosody where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+type ConfigFile = [String]
+
+type Conf = String
+
+confEnabled :: Conf -> ConfigFile -> RevertableProperty DebianLike DebianLike
+confEnabled conf cf = enable <!> disable
+ where
+ enable = dir `File.isSymlinkedTo` target
+ `describe` ("prosody conf enabled " ++ conf)
+ `requires` confAvailable conf cf
+ `requires` installed
+ `onChange` reloaded
+ where
+ target = confValRelativePath conf
+ dir = confValPath conf
+ confValRelativePath conf' = File.LinkTarget $
+ "../conf.avail" </> conf' <.> "cfg.lua"
+ disable = File.notPresent (confValPath conf)
+ `describe` ("prosody conf disabled " ++ conf)
+ `requires` installed
+ `onChange` reloaded
+
+confAvailable :: Conf -> ConfigFile -> Property DebianLike
+confAvailable conf cf = ("prosody conf available " ++ conf) ==>
+ tightenTargets (confAvailPath conf `File.hasContent` (comment : cf))
+ where
+ comment = "-- deployed with propellor, do not modify"
+
+confAvailPath :: Conf -> FilePath
+confAvailPath conf = "/etc/prosody/conf.avail" </> conf <.> "cfg.lua"
+
+confValPath :: Conf -> FilePath
+confValPath conf = "/etc/prosody/conf.d" </> conf <.> "cfg.lua"
+
+installed :: Property DebianLike
+installed = Apt.installed ["prosody"]
+
+restarted :: Property DebianLike
+restarted = Service.restarted "prosody"
+
+reloaded :: Property DebianLike
+reloaded = Service.reloaded "prosody"
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index 25e53159..5b854fa3 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -1,7 +1,30 @@
module Propellor.Property.Reboot where
-import Propellor
+import Propellor.Base
-now :: Property
-now = cmdProperty "reboot" []
+now :: Property Linux
+now = tightenTargets $ cmdProperty "reboot" []
+ `assume` MadeChange
`describe` "reboot now"
+
+-- | Schedules a reboot at the end of the current propellor run.
+--
+-- The `Result` code of the entire propellor run can be checked;
+-- the reboot proceeds only if the function returns True.
+--
+-- The reboot can be forced to run, which bypasses the init system. Useful
+-- if the init system might not be running for some reason.
+atEnd :: Bool -> (Result -> Bool) -> Property Linux
+atEnd force resultok = property "scheduled reboot at end of propellor run" $ do
+ endAction "rebooting" atend
+ return NoChange
+ where
+ atend r
+ | resultok r = liftIO $ toResult
+ <$> boolSystem "reboot" rebootparams
+ | otherwise = do
+ warningMessage "Not rebooting, due to status of propellor run."
+ return FailedChange
+ rebootparams
+ | force = [Param "--force"]
+ | otherwise = []
diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs
new file mode 100644
index 00000000..b40396de
--- /dev/null
+++ b/src/Propellor/Property/Rsync.hs
@@ -0,0 +1,62 @@
+module Propellor.Property.Rsync where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+
+type Src = FilePath
+type Dest = FilePath
+
+class RsyncParam p where
+ toRsync :: p -> String
+
+-- | A pattern that matches all files under a directory, but does not
+-- match the directory itself.
+filesUnder :: FilePath -> Pattern
+filesUnder d = Pattern (d ++ "/*")
+
+-- | Ensures that the Dest directory exists and has identical contents as
+-- the Src directory.
+syncDir :: Src -> Dest -> Property DebianLike
+syncDir = syncDirFiltered []
+
+data Filter
+ = Include Pattern
+ | Exclude Pattern
+ | Protect Pattern
+
+instance RsyncParam Filter where
+ toRsync (Include (Pattern p)) = "--include=" ++ p
+ toRsync (Exclude (Pattern p)) = "--exclude=" ++ p
+ toRsync (Protect (Pattern p)) = "--filter=P " ++ p
+
+-- | A pattern to match against files that rsync is going to transfer.
+--
+-- See "INCLUDE/EXCLUDE PATTERN RULES" in the rsync(1) man page.
+--
+-- For example, Pattern "/foo/*" matches all files under the "foo"
+-- directory, relative to the 'Src' that rsync is acting on.
+newtype Pattern = Pattern String
+
+-- | Like syncDir, but avoids copying anything that the filter list
+-- excludes. Anything that's filtered out will be deleted from Dest.
+--
+-- Rsync checks each name to be transferred against its list of Filter
+-- rules, and the first matching one is acted on. If no matching rule
+-- is found, the file is processed.
+syncDirFiltered :: [Filter] -> Src -> Dest -> Property DebianLike
+syncDirFiltered filters src dest = rsync $
+ [ "-av"
+ -- Add trailing '/' to get rsync to sync the Dest directory,
+ -- rather than a subdir inside it, which it will do without a
+ -- trailing '/'.
+ , addTrailingPathSeparator src
+ , addTrailingPathSeparator dest
+ , "--delete"
+ , "--delete-excluded"
+ , "--quiet"
+ ] ++ map toRsync filters
+
+rsync :: [String] -> Property DebianLike
+rsync ps = cmdProperty "rsync" ps
+ `assume` MadeChange
+ `requires` Apt.installed ["rsync"]
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
new file mode 100644
index 00000000..2647e69e
--- /dev/null
+++ b/src/Propellor/Property/Sbuild.hs
@@ -0,0 +1,383 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-|
+Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+Build and maintain schroots for use with sbuild.
+
+Suggested usage in @config.hs@:
+
+> & Apt.installed ["piuparts"]
+> & Sbuild.builtFor (System (Debian Unstable) "i386")
+> & Sbuild.piupartsConfFor (System (Debian Unstable) "i386")
+> & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1
+> & Sbuild.usableBy (User "spwhitton")
+> & Sbuild.shareAptCache
+> & Schroot.overlaysInTmpfs
+
+In @~/.sbuildrc@:
+
+> $run_piuparts = 1;
+> $piuparts_opts = [
+> '--schroot',
+> 'unstable-i386-piuparts',
+> '--fail-if-inadequate',
+> '--fail-on-broken-symlinks',
+> ];
+>
+> $external_commands = {
+> 'post-build-commands' => [
+> [
+> 'adt-run',
+> '--changes', '%c',
+> '---',
+> 'schroot', 'unstable-i386-sbuild;',
+>
+> # if adt-run's exit code is 8 then the package had no tests but
+> # this isn't a failure, so catch it
+> 'adtexit=$?;',
+> 'if', 'test', '$adtexit', '=', '8;', 'then',
+> 'exit', '0;', 'else', 'exit', '$adtexit;', 'fi'
+> ],
+> ],
+> };
+
+We use @sbuild-createchroot(1)@ to create a chroot to the specification of
+@sbuild-setup(7)@. This differs from the approach taken by picca's Sbuild.hs,
+which uses 'Propellor.Property.Debootstrap' to construct the chroot. This is
+because we don't want to run propellor inside the chroot in order to keep the
+sbuild environment as standard as possible.
+-}
+
+-- If you wanted to do it with Propellor.Property.Debootstrap, note that
+-- sbuild-createchroot has a --setup-only option
+
+module Propellor.Property.Sbuild (
+ -- * Creating and updating sbuild schroots
+ SbuildSchroot(..),
+ builtFor,
+ built,
+ updated,
+ updatedFor,
+ piupartsConfFor,
+ piupartsConf,
+ -- * Global sbuild configuration
+ -- blockNetwork,
+ installed,
+ keypairGenerated,
+ shareAptCache,
+ usableBy,
+) where
+
+import Propellor.Base
+import Propellor.Property.Debootstrap (extractSuite)
+import Propellor.Property.Chroot.Util
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Ccache as Ccache
+import qualified Propellor.Property.ConfFile as ConfFile
+import qualified Propellor.Property.File as File
+-- import qualified Propellor.Property.Firewall as Firewall
+import qualified Propellor.Property.User as User
+
+import Utility.FileMode
+import Data.List
+import Data.List.Utils
+
+type Suite = String
+
+-- | An sbuild schroot, such as would be listed by @schroot -l@
+--
+-- Parts of the sbuild toolchain cannot distinguish between schroots with both
+-- the same suite and the same architecture, so neither do we
+data SbuildSchroot = SbuildSchroot Suite Architecture
+
+instance Show SbuildSchroot where
+ show (SbuildSchroot suite arch) = suite ++ "-" ++ arch
+
+-- | Build and configure a schroot for use with sbuild using a distribution's
+-- standard mirror
+--
+-- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the
+-- user to identify the schroot and distribution using the 'System' type
+builtFor :: System -> RevertableProperty DebianLike UnixLike
+builtFor sys = go <!> deleted
+ where
+ go = property' ("sbuild schroot for " ++ show sys) $
+ \w -> case (schrootFromSystem sys, stdMirror sys) of
+ (Just s, Just u) -> ensureProperty w $
+ setupRevertableProperty $ built s u
+ _ -> errorMessage
+ ("don't know how to debootstrap " ++ show sys)
+ deleted = property' ("no sbuild schroot for " ++ show sys) $
+ \w -> case schrootFromSystem sys of
+ Just s -> ensureProperty w $
+ undoRevertableProperty $ built s "dummy"
+ Nothing -> noChange
+
+-- | Build and configure a schroot for use with sbuild
+built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike
+built s@(SbuildSchroot suite arch) mirror =
+ (go
+ `requires` keypairGenerated
+ `requires` ccachePrepared
+ `requires` installed)
+ <!> deleted
+ where
+ go :: Property DebianLike
+ go = check (unpopulated (schrootRoot s) <||> ispartial) $
+ property' ("built sbuild schroot for " ++ show s) make
+ make w = do
+ de <- liftIO standardPathEnv
+ let params = Param <$>
+ [ "--arch=" ++ arch
+ , "--chroot-suffix=-propellor"
+ , "--include=eatmydata,ccache"
+ , suite
+ , schrootRoot s
+ , mirror
+ ]
+ ifM (liftIO $
+ boolSystemEnv "sbuild-createchroot" params (Just de))
+ ( ensureProperty w $
+ fixConfFile s
+ `before` aliasesLine
+ `before` commandPrefix
+ , return FailedChange
+ )
+ deleted = check (not <$> unpopulated (schrootRoot s)) $
+ property ("no sbuild schroot for " ++ show s) $ do
+ liftIO $ removeChroot $ schrootRoot s
+ liftIO $ nukeFile
+ ("/etc/sbuild/chroot" </> show s ++ "-sbuild")
+ makeChange $ nukeFile (schrootConf s)
+
+ -- if we're building a sid chroot, add useful aliases
+ aliasesLine :: Property UnixLike
+ aliasesLine = if suite == "unstable"
+ then File.containsLine (schrootConf s)
+ "aliases=UNRELEASED,sid,rc-buggy,experimental"
+ else doNothing
+ -- enable ccache and eatmydata for speed
+ commandPrefix = File.containsLine (schrootConf s)
+ "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata"
+
+ -- A failed debootstrap run will leave a debootstrap directory;
+ -- recover by deleting it and trying again.
+ ispartial = ifM (doesDirectoryExist (schrootRoot s </> "debootstrap"))
+ ( do
+ removeChroot $ schrootRoot s
+ return True
+ , return False
+ )
+
+-- | Ensure that an sbuild schroot's packages and apt indexes are updated
+--
+-- This function is a convenience wrapper around 'Sbuild.updated', allowing the
+-- user to identify the schroot using the 'System' type
+updatedFor :: System -> Property DebianLike
+updatedFor system = property' ("updated sbuild schroot for " ++ show system) $
+ \w -> case schrootFromSystem system of
+ Just s -> ensureProperty w $ updated s
+ Nothing -> errorMessage
+ ("don't know how to debootstrap " ++ show system)
+
+-- | Ensure that an sbuild schroot's packages and apt indexes are updated
+updated :: SbuildSchroot -> Property DebianLike
+updated s@(SbuildSchroot suite arch) =
+ check (doesDirectoryExist (schrootRoot s)) $ go
+ `describe` ("updated schroot for " ++ show s)
+ `requires` keypairGenerated
+ `requires` installed
+ where
+ go :: Property DebianLike
+ go = tightenTargets $ cmdProperty
+ "sbuild-update" ["-udr", suite ++ "-" ++ arch]
+ `assume` MadeChange
+
+-- Find the conf file that sbuild-createchroot(1) made when we passed it
+-- --chroot-suffix=propellor, and edit and rename such that it is as if we
+-- passed --chroot-suffix=sbuild (the default). Replace the random suffix with
+-- 'propellor'.
+--
+-- We had to pass --chroot-suffix=propellor in order that we can find a unique
+-- config file for the schroot we just built, despite the random suffix.
+--
+-- The properties in this module only permit the creation of one chroot for a
+-- given suite and architecture, so we don't need the suffix to be random.
+fixConfFile :: SbuildSchroot -> Property UnixLike
+fixConfFile s@(SbuildSchroot suite arch) =
+ property' ("schroot for " ++ show s ++ " config file fixed") $ \w -> do
+ confs <- liftIO $ dirContents dir
+ let old = concat $ filter (tempPrefix `isPrefixOf`) confs
+ liftIO $ moveFile old new
+ liftIO $ moveFile
+ ("/etc/sbuild/chroot" </> show s ++ "-propellor")
+ ("/etc/sbuild/chroot" </> show s ++ "-sbuild")
+ ensureProperty w $
+ File.fileProperty "replace dummy suffix" (map munge) new
+ where
+ new = schrootConf s
+ dir = takeDirectory new
+ tempPrefix = dir </> suite ++ "-" ++ arch ++ "-propellor-"
+ munge = replace "-propellor]" "-sbuild]"
+
+-- | Create a corresponding schroot config file for use with piuparts
+--
+-- This function is a convenience wrapper around 'Sbuild.piupartsConf', allowing
+-- the user to identify the schroot using the 'System' type. See that
+-- function's documentation for why you might want to use this property, and
+-- sample config.
+piupartsConfFor :: System -> Property DebianLike
+piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $
+ \w -> case (schrootFromSystem sys, stdMirror sys) of
+ (Just s, Just u) -> ensureProperty w $
+ piupartsConf s u
+ _ -> errorMessage
+ ("don't know how to debootstrap " ++ show sys)
+
+-- | Create a corresponding schroot config file for use with piuparts
+--
+-- This is useful because:
+--
+-- - piuparts will clear out the apt cache which makes 'Sbuild.shareAptCache'
+-- much less useful
+--
+-- - piuparts itself invokes eatmydata, so the command-prefix setting in our
+-- regular schroot config would force the user to pass --no-eatmydata to
+-- piuparts in their @~/.sbuildrc@, which is inconvenient.
+--
+-- To make use of this new schroot config, you can put something like this in
+-- your ~/.sbuildrc:
+--
+-- > $run_piuparts = 1;
+-- > $piuparts_opts = [
+-- > '--schroot',
+-- > 'unstable-i386-piuparts',
+-- > '--fail-if-inadequate',
+-- > '--fail-on-broken-symlinks',
+-- > ];
+piupartsConf :: SbuildSchroot -> Apt.Url -> Property DebianLike
+piupartsConf s u = go
+ `requires` (setupRevertableProperty $ built s u)
+ `describe` ("piuparts schroot conf for " ++ show s)
+ where
+ go :: Property DebianLike
+ go = tightenTargets $
+ check (not <$> doesFileExist f)
+ (File.basedOn f (schrootConf s, map munge))
+ `before`
+ ConfFile.containsIniSetting f (sec, "profile", "piuparts")
+ `before`
+ ConfFile.containsIniSetting f (sec, "aliases", "")
+ `before`
+ ConfFile.containsIniSetting f (sec, "command-prefix", "")
+ `before`
+ File.dirExists dir
+ `before`
+ File.isSymlinkedTo (dir </> "copyfiles")
+ (File.LinkTarget $ orig </> "copyfiles")
+ `before`
+ File.isSymlinkedTo (dir </> "nssdatabases")
+ (File.LinkTarget $ orig </> "nssdatabases")
+ `before`
+ File.basedOn (dir </> "fstab")
+ (orig </> "fstab", filter (/= aptCacheLine))
+
+ orig = "/etc/schroot/sbuild"
+ dir = "/etc/schroot/piuparts"
+ sec = show s ++ "-piuparts"
+ f = schrootPiupartsConf s
+ munge = replace "-sbuild]" "-piuparts]"
+
+-- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host
+-- system and the chroot share the apt cache
+--
+-- This speeds up builds by avoiding unnecessary downloads of build
+-- dependencies.
+shareAptCache :: Property DebianLike
+shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab" aptCacheLine
+ `requires` installed
+ `describe` "sbuild schroots share host apt cache"
+
+aptCacheLine :: String
+aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0"
+
+-- | Ensure that sbuild is installed
+installed :: Property DebianLike
+installed = Apt.installed ["sbuild"]
+
+-- | Add an user to the sbuild group in order to use sbuild
+usableBy :: User -> Property DebianLike
+usableBy u = User.hasGroup u (Group "sbuild") `requires` installed
+
+-- | Generate the apt keys needed by sbuild
+keypairGenerated :: Property DebianLike
+keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go
+ `requires` installed
+ where
+ go :: Property DebianLike
+ go = tightenTargets $
+ cmdProperty "sbuild-update" ["--keygen"]
+ `assume` MadeChange
+ secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec"
+
+-- another script from wiki.d.o/sbuild
+ccachePrepared :: Property DebianLike
+ccachePrepared = propertyList "sbuild group ccache configured" $ props
+ -- We only set a limit on the cache if it doesn't already exist, so the
+ -- user can override our default limit
+ & check (not <$> doesDirectoryExist "/var/cache/ccache-sbuild")
+ (Ccache.hasLimits "/var/cache/ccache-sbuild" (Ccache.MaxSize "2G"))
+ `before` Ccache.hasCache (Group "sbuild") Ccache.NoLimit
+ & "/etc/schroot/sbuild/fstab" `File.containsLine`
+ "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0"
+ `describe` "ccache mounted in sbuild schroots"
+ & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent`
+ [ "#!/bin/sh"
+ , ""
+ , "export CCACHE_DIR=/var/cache/ccache-sbuild"
+ , "export CCACHE_UMASK=002"
+ , "export CCACHE_COMPRESS=1"
+ , "unset CCACHE_HARDLINK"
+ , "export PATH=\"/usr/lib/ccache:$PATH\""
+ , ""
+ , "exec \"$@\""
+ ]
+ & File.mode "/var/cache/ccache-sbuild/sbuild-setup"
+ (combineModes (readModes ++ executeModes))
+
+-- This doesn't seem to work with the current version of sbuild
+-- -- | Block network access during builds
+-- --
+-- -- This is a hack from <https://wiki.debian.org/sbuild> until #802850 and
+-- -- #802849 are resolved.
+-- blockNetwork :: Property Linux
+-- blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP
+-- (Firewall.GroupOwner (Group "sbuild")
+-- <> Firewall.NotDestination
+-- [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8])
+-- `requires` installed -- sbuild group must exist
+
+-- ==== utility functions ====
+
+schrootFromSystem :: System -> Maybe SbuildSchroot
+schrootFromSystem system@(System _ arch) =
+ extractSuite system
+ >>= \suite -> return $ SbuildSchroot suite arch
+
+stdMirror :: System -> Maybe Apt.Url
+stdMirror (System (Debian _) _) = Just "http://httpredir.debian.org/debian"
+stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/"
+stdMirror _ = Nothing
+
+schrootRoot :: SbuildSchroot -> FilePath
+schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ a
+
+schrootConf :: SbuildSchroot -> FilePath
+schrootConf (SbuildSchroot s a) =
+ "/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-sbuild-propellor"
+
+schrootPiupartsConf :: SbuildSchroot -> FilePath
+schrootPiupartsConf (SbuildSchroot s a) =
+ "/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-piuparts-propellor"
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index f2911e50..729a3749 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
+
module Propellor.Property.Scheduled
( period
, periodParse
@@ -7,7 +9,8 @@ module Propellor.Property.Scheduled
, YearDay
) where
-import Propellor
+import Propellor.Base
+import Propellor.Types.Core
import Utility.Scheduled
import Data.Time.Clock
@@ -18,26 +21,26 @@ import qualified Data.Map as M
--
-- This uses the description of the Property to keep track of when it was
-- last run.
-period :: Property -> Recurrance -> Property
-period prop recurrance = flip describe desc $ adjustProperty prop $ \satisfy -> do
- lasttime <- liftIO $ getLastChecked (propertyDesc prop)
+period :: (IsProp (Property i)) => Property i -> Recurrance -> Property i
+period prop recurrance = flip describe desc $ adjustPropertySatisfy prop $ \satisfy -> do
+ lasttime <- liftIO $ getLastChecked (getDesc prop)
nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
t <- liftIO localNow
if Just t >= nexttime
then do
r <- satisfy
- liftIO $ setLastChecked t (propertyDesc prop)
+ liftIO $ setLastChecked t (getDesc prop)
return r
else noChange
where
schedule = Schedule recurrance AnyTime
- desc = propertyDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
+ desc = getDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
-- | Like period, but parse a human-friendly string.
-periodParse :: Property -> String -> Property
+periodParse :: (IsProp (Property i)) => Property i -> String -> Property i
periodParse prop s = case toRecurrance s of
Just recurrance -> period prop recurrance
- Nothing -> property "periodParse" $ do
+ Nothing -> adjustPropertySatisfy prop $ \_ -> do
liftIO $ warningMessage $ "failed periodParse: " ++ s
noChange
diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs
new file mode 100644
index 00000000..c53ce4f1
--- /dev/null
+++ b/src/Propellor/Property/Schroot.hs
@@ -0,0 +1,42 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+module Propellor.Property.Schroot where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+import Utility.FileMode
+
+-- | Configure schroot such that all schroots with @union-type=overlay@ in their
+-- configuration will run their overlays in a tmpfs.
+--
+-- Shell script from <https://wiki.debian.org/sbuild>.
+overlaysInTmpfs :: Property DebianLike
+overlaysInTmpfs = go `requires` installed
+ where
+ f = "/etc/schroot/setup.d/04tmpfs"
+ go :: Property UnixLike
+ go = f `File.hasContent`
+ [ "#!/bin/sh"
+ , ""
+ , "set -e"
+ , ""
+ , ". \"$SETUP_DATA_DIR/common-data\""
+ , ". \"$SETUP_DATA_DIR/common-functions\""
+ , ". \"$SETUP_DATA_DIR/common-config\""
+ , ""
+ , ""
+ , "if [ $STAGE = \"setup-start\" ]; then"
+ , " mount -t tmpfs overlay /var/lib/schroot/union/overlay"
+ , "elif [ $STAGE = \"setup-recover\" ]; then"
+ , " mount -t tmpfs overlay /var/lib/schroot/union/overlay"
+ , "elif [ $STAGE = \"setup-stop\" ]; then"
+ , " umount -f /var/lib/schroot/union/overlay"
+ , "fi"
+ ]
+ `onChange` (f `File.mode` (combineModes (readModes ++ executeModes)))
+ `describe` "schroot overlays in tmpfs"
+
+installed :: Property DebianLike
+installed = Apt.installed ["schroot"]
diff --git a/src/Propellor/Property/Service.hs b/src/Propellor/Property/Service.hs
index 14e769d0..46f9e8ef 100644
--- a/src/Propellor/Property/Service.hs
+++ b/src/Propellor/Property/Service.hs
@@ -1,7 +1,6 @@
module Propellor.Property.Service where
-import Propellor
-import Utility.SafeCommand
+import Propellor.Base
type ServiceName = String
@@ -12,20 +11,17 @@ type ServiceName = String
-- Note that due to the general poor state of init scripts, the best
-- we can do is try to start the service, and if it fails, assume
-- this means it's already running.
-running :: ServiceName -> Property
-running svc = property ("running " ++ svc) $ do
- void $ ensureProperty $
- scriptProperty ["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"]
- return NoChange
+running :: ServiceName -> Property DebianLike
+running = signaled "start" "running"
-restarted :: ServiceName -> Property
-restarted svc = property ("restarted " ++ svc) $ do
- void $ ensureProperty $
- scriptProperty ["service " ++ shellEscape svc ++ " restart >/dev/null 2>&1 || true"]
- return NoChange
+restarted :: ServiceName -> Property DebianLike
+restarted = signaled "restart" "restarted"
-reloaded :: ServiceName -> Property
-reloaded svc = property ("reloaded " ++ svc) $ do
- void $ ensureProperty $
- scriptProperty ["service " ++ shellEscape svc ++ " reload >/dev/null 2>&1 || true"]
- return NoChange
+reloaded :: ServiceName -> Property DebianLike
+reloaded = signaled "reload" "reloaded"
+
+signaled :: String -> Desc -> ServiceName -> Property DebianLike
+signaled cmd desc svc = tightenTargets $ p `describe` (desc ++ " " ++ svc)
+ where
+ p = scriptProperty ["service " ++ shellEscape svc ++ " " ++ cmd ++ " >/dev/null 2>&1 || true"]
+ `assume` NoChange
diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs
new file mode 100644
index 00000000..239bcbeb
--- /dev/null
+++ b/src/Propellor/Property/SiteSpecific/Branchable.hs
@@ -0,0 +1,68 @@
+module Propellor.Property.SiteSpecific.Branchable where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.User as User
+import qualified Propellor.Property.Ssh as Ssh
+import qualified Propellor.Property.Postfix as Postfix
+import qualified Propellor.Property.Gpg as Gpg
+import qualified Propellor.Property.Sudo as Sudo
+
+server :: [Host] -> Property (HasInfo + DebianLike)
+server hosts = propertyList "branchable server" $ props
+ & "/etc/timezone" `File.hasContent` ["Etc/UTC"]
+ & "/etc/locale.gen" `File.containsLines`
+ [ "en_GB.UTF-8 UTF-8"
+ , "en_US.UTF-8 UTF-8"
+ , "fi_FI.UTF-8 UTF-8"
+ ]
+ `onChange` (cmdProperty "locale-gen" [] `assume` MadeChange)
+
+ & Apt.installed ["etckeeper", "ssh", "popularity-contest"]
+ & Apt.serviceInstalledRunning "apache2"
+ & Apt.serviceInstalledRunning "ntp"
+
+ & Apt.serviceInstalledRunning "openssh-server"
+ & Ssh.passwordAuthentication False
+ & Ssh.hostKeys (Context "branchable.com")
+ [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAK9HnfpyIm8aEhKuF5oz6KyaLwFs2oWeToVkqVuykyy5Y8jWDZPtkpv+1TeOnjcOvJSZ1cCqB8iXlsP9Dr5z98w5MfzsRQM2wIw0n+wvmpPmUhjVdGh+wTpfP9bcyFHhj/f1Ymdq9hEWB26bnf4pbTbJW2ip8ULshMvn5CQ/ugV3AAAAFQCAjpRd1fquRiIuLJMwej0VcyoZKQAAAIBe91Grvz/icL3nlqXYrifXyr9dsw8bPN+BMu+hQtFsQXNJBylxwf8FtbRlmvZXmRjdVYqFVyxSsrL2pMsWlds51iXOr9pdsPG5a4OgJyRHsveBz3tz6HgYYPcr3Oxp7C6G6wrzwsaGK862SgRp/bbD226k9dODRBy3ogMhk/MvAgAAAIEApfknql3vZbDVa88ZnwbNKDOv8L1hb6blbKAMt2vJbqJMvu3EP9CsP9hGyEQh5YCAl2F9KEU3bJXN1BG76b7CiYtWK95lpL1XmCCWnJBCcdEhw998GfJS424frPw7qGmXLxJKYxEyioB90/IDp2dC+WaLcLOYHM9SroCQTIK5A1g= root@pell")
+ , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEA1M0aNLgcgcgf0tkmt/8vCDZLok8Xixz7Nun9wB6NqVXxfzAR4te+zyO7FucVwyTY5QHmiwwpmyNfaC21AAILhXGm12SUKSAirF9BkQk7bhQuz4T/dPlEt3d3SxQ3OZlXtPp4LzXWOyS0OXSzIb+HeaDA+hFXlQnp/gE7RyAzR1+xhWPO7Mz1q5O/+4dXANnW32t6P7Puob6NsglVDpLrMRYjkO+0RgCVbYMzB5+UnkthkZsIINaYwsNhW2GKMKbRZeyp5en5t1NJprGXdw0BqdBqd/rcBpOxmhHE1U7rw+GS1uZwCFWWv0aZbaXEJ6wY7mETFkqs0QXi5jtoKn95Gw== root@pell")
+ ]
+
+ & Apt.installed ["procmail", "bsd-mailx"]
+ & "/etc/aliases" `File.hasPrivContentExposed` (Context "branchable.com")
+ `onChange` Postfix.newaliases
+ & "/etc/mailname" `File.hasContent` ["branchable.com"]
+ & Postfix.installed
+ & Postfix.mainCf ("mailbox_command", "procmail -a \"$EXTENSION\"")
+
+ -- Obnam is run by a cron job in ikiwiki-hosting.
+ & "/etc/obnam.conf" `File.hasContent`
+ [ "[config]"
+ , "repository = sftp://joey@eubackup.kitenet.net/home/joey/lib/backup/pell.obnam"
+ , "log = /var/log/obnam.log"
+ , "encrypt-with = " ++ obnamkey
+ , "log-level = info"
+ , "log-max = 1048576"
+ , "keep = 7d,5w,12m"
+ , "upload-queue-size = 128"
+ , "lru-size = 128"
+ ]
+ & Gpg.keyImported (Gpg.GpgKeyId obnamkey) (User "root")
+ & Ssh.userKeys (User "root") (Context "branchable.com")
+ [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC2PqTSupwncqeffNwZQXacdEWp7L+TxllIxH7WjfRMb3U74mQxWI0lwqLVW6Fox430DvhSqF1y5rJBvTHh4i49Tc9lZ7mwAxA6jNOP6bmdfteaKKYmUw5qwtJW0vISBFu28qBO11Nq3uJ1D3Oj6N+b3mM/0D3Y3NoGgF8+2dLdi81u9+l6AQ5Jsnozi2Ni/Osx2oVGZa+IQDO6gX8VEP4OrcJFNJe8qdnvItcGwoivhjbIfzaqNNvswKgGzhYLOAS5KT8HsjvIpYHWkyQ5QUX7W/lqGSbjP+6B8C3tkvm8VLXbmaD+aSkyCaYbuoXC2BoJdS7Jh8phKMwPJmdYVepn")
+ ]
+ & Ssh.knownHost hosts "eubackup.kitenet.net" (User "root")
+ & Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
+
+ & adminuser "joey"
+ & adminuser "liw"
+ where
+ obnamkey = "41E1A9B9"
+ adminuser u = propertyList ("admin user " ++ u) $ props
+ & User.accountFor (User u)
+ & User.hasSomePassword (User u)
+ & Sudo.enabledFor (User u)
+ & User.hasGroup (User u) (Group "adm")
+ & User.hasGroup (User u) (Group "systemd-journal")
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 901eba2e..b4812c7e 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -1,13 +1,15 @@
+{-# LANGUAGE FlexibleContexts #-}
+
module Propellor.Property.SiteSpecific.GitAnnexBuilder where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.User as User
import qualified Propellor.Property.Cron as Cron
-import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.File as File
-import qualified Propellor.Property.Docker as Docker
-import Propellor.Property.Cron (CronTimes)
+import qualified Propellor.Property.Systemd as Systemd
+import qualified Propellor.Property.Chroot as Chroot
+import Propellor.Property.Cron (Times)
builduser :: UserName
builduser = "builder"
@@ -23,105 +25,181 @@ builddir = gitbuilderdir </> "build"
type TimeOut = String -- eg, 5h
-autobuilder :: Architecture -> CronTimes -> TimeOut -> Property
-autobuilder arch crontimes timeout = combineProperties "gitannexbuilder"
- [ Apt.serviceInstalledRunning "cron"
- , Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir $
- "git pull ; timeout " ++ timeout ++ " ./autobuild"
+autobuilder :: Architecture -> Times -> TimeOut -> Property (HasInfo + DebianLike)
+autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
+ & Apt.serviceInstalledRunning "cron"
+ & Cron.niceJob "gitannexbuilder" crontimes (User builduser) gitbuilderdir
+ ("git pull ; timeout " ++ timeout ++ " ./autobuild")
+ & rsyncpassword
+ where
+ context = Context ("gitannexbuilder " ++ arch)
+ pwfile = homedir </> "rsyncpassword"
-- The builduser account does not have a password set,
-- instead use the password privdata to hold the rsync server
-- password used to upload the built image.
- , withPrivData (Password builduser) context $ \getpw ->
+ rsyncpassword :: Property (HasInfo + DebianLike)
+ rsyncpassword = withPrivData (Password builduser) context $ \getpw ->
property "rsync password" $ getpw $ \pw -> do
- oldpw <- liftIO $ catchDefaultIO "" $
+ have <- liftIO $ catchDefaultIO "" $
readFileStrict pwfile
- if pw /= oldpw
- then makeChange $ writeFile pwfile pw
+ let want = privDataVal pw
+ if want /= have
+ then makeChange $ writeFile pwfile want
else noChange
- ]
- where
- context = Context ("gitannexbuilder " ++ arch)
- pwfile = homedir </> "rsyncpassword"
-tree :: Architecture -> Property
-tree buildarch = combineProperties "gitannexbuilder tree"
- [ Apt.installed ["git"]
- -- gitbuilderdir directory already exists when docker volume is used,
- -- but with wrong owner.
- , File.dirExists gitbuilderdir
- , File.ownerGroup gitbuilderdir builduser builduser
- , check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $
- userScriptProperty builduser
+tree :: Architecture -> Flavor -> Property DebianLike
+tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
+ & Apt.installed ["git"]
+ & File.dirExists gitbuilderdir
+ & File.ownerGroup gitbuilderdir (User builduser) (Group builduser)
+ & gitannexbuildercloned
+ & builddircloned
+ where
+ gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $
+ userScriptProperty (User builduser)
[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir
, "cd " ++ gitbuilderdir
- , "git checkout " ++ buildarch
+ , "git checkout " ++ buildarch ++ fromMaybe "" flavor
]
+ `assume` MadeChange
`describe` "gitbuilder setup"
- , check (not <$> doesDirectoryExist builddir) $ userScriptProperty builduser
+ builddircloned = check (not <$> doesDirectoryExist builddir) $ userScriptProperty (User builduser)
[ "git clone git://git-annex.branchable.com/ " ++ builddir
]
- ]
-buildDepsApt :: Property
-buildDepsApt = combineProperties "gitannexbuilder build deps"
- [ Apt.buildDep ["git-annex"]
- , Apt.installed ["liblockfile-simple-perl"]
- , buildDepsNoHaskellLibs
- , "git-annex source build deps installed" ==> Apt.buildDepIn builddir
- ]
+buildDepsApt :: Property DebianLike
+buildDepsApt = combineProperties "gitannexbuilder build deps" $ props
+ & Apt.buildDep ["git-annex"]
+ & buildDepsNoHaskellLibs
+ & Apt.buildDepIn builddir
+ `describe` "git-annex source build deps installed"
-buildDepsNoHaskellLibs :: Property
+buildDepsNoHaskellLibs :: Property DebianLike
buildDepsNoHaskellLibs = Apt.installed
["git", "rsync", "moreutils", "ca-certificates",
"debhelper", "ghc", "curl", "openssh-client", "git-remote-gcrypt",
"liblockfile-simple-perl", "cabal-install", "vim", "less",
-- needed by haskell libs
- "libxml2-dev", "libidn11-dev", "libgsasl7-dev", "libgnutls-dev",
- "alex", "happy", "c2hs"
+ "libxml2-dev", "libidn11-dev", "libgsasl7-dev", "libgnutls28-dev",
+ "libmagic-dev", "alex", "happy", "c2hs"
]
+haskellPkgsInstalled :: String -> Property DebianLike
+haskellPkgsInstalled dir = tightenTargets $
+ flagFile go ("/haskellpkgsinstalled")
+ where
+ go = userScriptProperty (User builduser)
+ [ "cd " ++ builddir ++ " && ./standalone/" ++ dir ++ "/install-haskell-packages"
+ ]
+ `assume` MadeChange
+
-- Installs current versions of git-annex's deps from cabal, but only
-- does so once.
-cabalDeps :: Property
+cabalDeps :: Property UnixLike
cabalDeps = flagFile go cabalupdated
where
- go = userScriptProperty builduser ["cabal update && cabal install git-annex --only-dependencies || true"]
+ go = userScriptProperty (User builduser)
+ ["cabal update && cabal install git-annex --only-dependencies || true"]
+ `assume` MadeChange
cabalupdated = homedir </> ".cabal" </> "packages" </> "hackage.haskell.org" </> "00-index.cache"
-standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Host
-standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.container (arch ++ "-git-annex-builder")
- (dockerImage $ System (Debian Testing) arch)
- & os (System (Debian Testing) arch)
- & Apt.stdSourcesList
- & Apt.installed ["systemd"]
- & Apt.unattendedUpgrades
- & User.accountFor builduser
- & tree arch
- & buildDepsApt
- & autobuilder arch (show buildminute ++ " * * * *") timeout
- & Docker.tweaked
-
-androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
-androidAutoBuilderContainer dockerImage crontimes timeout =
- androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir
+autoBuilderContainer :: (DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)) -> DebianSuite -> Architecture -> Flavor -> Times -> TimeOut -> Systemd.Container
+autoBuilderContainer mkprop suite arch flavor crontime timeout =
+ Systemd.container name $ \d -> Chroot.debootstrapped mempty d $ props
+ & mkprop suite arch flavor
+ & autobuilder arch crontime timeout
+ where
+ name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
+
+type Flavor = Maybe String
+
+standardAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+standardAutoBuilder suite arch flavor =
+ propertyList "standard git-annex autobuilder" $ props
+ & osDebian suite arch
+ & buildDepsApt
+ & Apt.stdSourcesList
& Apt.unattendedUpgrades
- & autobuilder "android" crontimes timeout
+ & Apt.cacheCleaned
+ & User.accountFor (User builduser)
+ & tree arch flavor
+
+stackAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+stackAutoBuilder suite arch flavor =
+ propertyList "git-annex autobuilder using stack" $ props
+ & osDebian suite arch
+ & buildDepsNoHaskellLibs
+ & Apt.stdSourcesList
+ & Apt.unattendedUpgrades
+ & Apt.cacheCleaned
+ & User.accountFor (User builduser)
+ & tree arch flavor
+ & stackInstalled
+ -- Workaround https://github.com/commercialhaskell/stack/issues/2093
+ & Apt.installed ["libtinfo-dev"]
+
+stackInstalled :: Property Linux
+stackInstalled = withOS "stack installed" $ \w o ->
+ case o of
+ (Just (System (Debian (Stable "jessie")) "i386")) ->
+ ensureProperty w $ manualinstall "i386"
+ _ -> ensureProperty w $ Apt.installed ["haskell-stack"]
+ where
+ -- Warning: Using a binary downloaded w/o validation.
+ manualinstall :: Architecture -> Property Linux
+ manualinstall arch = tightenTargets $ check (not <$> doesFileExist binstack) $
+ propertyList "stack installed from upstream tarball" $ props
+ & cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar]
+ `assume` MadeChange
+ & File.dirExists tmpdir
+ & cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"]
+ `assume` MadeChange
+ & cmdProperty "mv" [tmpdir </> "stack", binstack]
+ `assume` MadeChange
+ & cmdProperty "rm" ["-rf", tmpdir, tmptar]
+ `assume` MadeChange
+ binstack = "/usr/bin/stack"
+ tmptar = "/root/stack.tar.gz"
+ tmpdir = "/root/stack"
+
+armAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
+armAutoBuilder suite arch flavor =
+ propertyList "arm git-annex autobuilder" $ props
+ & standardAutoBuilder suite arch flavor
+ & buildDepsNoHaskellLibs
+ -- Works around ghc crash with parallel builds on arm.
+ & (homedir </> ".cabal" </> "config")
+ `File.lacksLine` "jobs: $ncpus"
+ -- Install patched haskell packages for portability to
+ -- arm NAS's using old kernel versions.
+ & haskellPkgsInstalled "linux"
+
+androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container
+androidAutoBuilderContainer crontimes timeout =
+ androidAutoBuilderContainer' "android-git-annex-builder"
+ (tree "android" Nothing) builddir crontimes timeout
-- Android is cross-built in a Debian i386 container, using the Android NDK.
-androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host
-androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.container name
- (dockerImage osver)
- & os osver
- & Apt.stdSourcesList
- & Apt.installed ["systemd"]
- & Docker.tweaked
- & User.accountFor builduser
- & File.dirExists gitbuilderdir
- & File.ownerGroup homedir builduser builduser
- & buildDepsApt
- & flagFile chrootsetup ("/chrootsetup")
- `requires` setupgitannexdir
- & flagFile haskellpkgsinstalled ("/haskellpkgsinstalled")
+androidAutoBuilderContainer'
+ :: Systemd.MachineName
+ -> Property DebianLike
+ -> FilePath
+ -> Times
+ -> TimeOut
+ -> Systemd.Container
+androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout =
+ Systemd.container name $ \d -> bootstrap d $ props
+ & osDebian (Stable "jessie") "i386"
+ & Apt.stdSourcesList
+ & User.accountFor (User builduser)
+ & File.dirExists gitbuilderdir
+ & File.ownerGroup homedir (User builduser) (Group builduser)
+ & flagFile chrootsetup ("/chrootsetup")
+ `requires` setupgitannexdir
+ & haskellPkgsInstalled "android"
+ & Apt.unattendedUpgrades
+ & buildDepsNoHaskellLibs
+ & autobuilder "android" crontimes timeout
where
-- Use git-annex's android chroot setup script, which will install
-- ghc-android and the NDK, all build deps, etc, in the home
@@ -129,54 +207,5 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe
chrootsetup = scriptProperty
[ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot"
]
- haskellpkgsinstalled = userScriptProperty "builder"
- [ "cd " ++ gitannexdir ++ " && ./standalone/android/install-haskell-packages"
- ]
- osver = System (Debian Testing) "i386" -- once jessie is released, use: (Stable "jessie")
-
--- armel builder has a companion container using amd64 that
--- runs the build first to get TH splices. They need
--- to have the same versions of all haskell libraries installed.
-armelCompanionContainer :: (System -> Docker.Image) -> Host
-armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-companion"
- (dockerImage $ System (Debian Unstable) "amd64")
- & os (System (Debian Testing) "amd64")
- & Apt.stdSourcesList
- & Apt.installed ["systemd"]
- -- This volume is shared with the armel builder.
- & Docker.volume gitbuilderdir
- & User.accountFor builduser
- -- Install current versions of build deps from cabal.
- & tree "armel"
- & buildDepsNoHaskellLibs
- & cabalDeps
- -- The armel builder can ssh to this companion.
- & Docker.expose "22"
- & Apt.serviceInstalledRunning "ssh"
- & Ssh.authorizedKeys builduser (Context "armel-git-annex-builder")
- & Docker.tweaked
-
-armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
-armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder"
- (dockerImage $ System (Debian Unstable) "armel")
- & os (System (Debian Testing) "armel")
- & Apt.stdSourcesList
- & Apt.installed ["systemd"]
- & Apt.installed ["openssh-client"]
- & Docker.link "armel-git-annex-builder-companion" "companion"
- & Docker.volumes_from "armel-git-annex-builder-companion"
- & User.accountFor builduser
- -- TODO: automate installing haskell libs
- -- (Currently have to run
- -- git-annex/standalone/linux/install-haskell-packages
- -- which is not fully automated.)
- & buildDepsNoHaskellLibs
- & autobuilder "armel" crontimes timeout
- `requires` tree "armel"
- & Ssh.keyImported SshRsa builduser (Context "armel-git-annex-builder")
- & trivial writecompanionaddress
- & Docker.tweaked
- where
- writecompanionaddress = scriptProperty
- [ "echo \"$COMPANION_PORT_22_TCP_ADDR\" > " ++ homedir </> "companion_address"
- ] `describe` "companion_address file"
+ `assume` MadeChange
+ bootstrap = Chroot.debootstrapped mempty
diff --git a/src/Propellor/Property/SiteSpecific/GitHome.hs b/src/Propellor/Property/SiteSpecific/GitHome.hs
index 6ed02146..f14b5f12 100644
--- a/src/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/src/Propellor/Property/SiteSpecific/GitHome.hs
@@ -1,25 +1,27 @@
module Propellor.Property.SiteSpecific.GitHome where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.User
-import Utility.SafeCommand
-- | Clones Joey Hess's git home directory, and runs its fixups script.
-installedFor :: UserName -> Property
-installedFor user = check (not <$> hasGitDir user) $
- property ("githome " ++ user) (go =<< liftIO (homedir user))
- `requires` Apt.installed ["git"]
+installedFor :: User -> Property DebianLike
+installedFor user@(User u) = check (not <$> hasGitDir user) $
+ go `requires` Apt.installed ["git"]
where
- go home = do
+ go :: Property DebianLike
+ go = property' ("githome " ++ u) $ \w -> do
+ home <- liftIO (homedir user)
let tmpdir = home </> "githome"
- ensureProperty $ combineProperties "githome setup"
+ ensureProperty w $ combineProperties "githome setup" $ toProps
[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
+ `assume` MadeChange
, property "moveout" $ makeChange $ void $
moveout tmpdir home
, property "rmdir" $ makeChange $ void $
catchMaybeIO $ removeDirectory tmpdir
, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; bin/mr checkout; bin/fixups"]
+ `assume` MadeChange
]
moveout tmpdir home = do
fs <- dirContents tmpdir
@@ -28,7 +30,7 @@ installedFor user = check (not <$> hasGitDir user) $
url :: String
url = "git://git.kitenet.net/joey/home"
-hasGitDir :: UserName -> IO Bool
+hasGitDir :: User -> IO Bool
hasGitDir user = go =<< homedir user
where
go home = doesDirectoryExist (home </> ".git")
diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs
new file mode 100644
index 00000000..b245e444
--- /dev/null
+++ b/src/Propellor/Property/SiteSpecific/IABak.hs
@@ -0,0 +1,121 @@
+module Propellor.Property.SiteSpecific.IABak where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Git as Git
+import qualified Propellor.Property.Cron as Cron
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apache as Apache
+import qualified Propellor.Property.User as User
+import qualified Propellor.Property.Ssh as Ssh
+
+repo :: String
+repo = "https://github.com/ArchiveTeam/IA.BAK/"
+
+userrepo :: String
+userrepo = "git@gitlab.com:archiveteam/IA.bak.users.git"
+
+publicFace :: Property DebianLike
+publicFace = propertyList "iabak public face" $ props
+ & Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server")
+ & Apt.serviceInstalledRunning "apache2"
+ & Cron.niceJob "graph-gen" (Cron.Times "*/10 * * * *") (User "root") "/"
+ "/usr/local/IA.BAK/web/graph-gen.sh"
+
+gitServer :: [Host] -> Property (HasInfo + DebianLike)
+gitServer knownhosts = propertyList "iabak git server" $ props
+ & Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server")
+ & Git.cloned (User "root") repo "/usr/local/IA.BAK/client" (Just "master")
+ & Ssh.userKeys (User "root") (Context "IA.bak.users.git") sshKeys
+ & Ssh.knownHost knownhosts "gitlab.com" (User "root")
+ & Git.cloned (User "root") userrepo "/usr/local/IA.BAK/pubkeys" (Just "master")
+ & Apt.serviceInstalledRunning "apache2"
+ & "/usr/lib/cgi-bin/pushme.cgi" `File.isSymlinkedTo` File.LinkTarget "/usr/local/IA.BAK/pushme.cgi"
+ & File.containsLine "/etc/sudoers" "www-data ALL=NOPASSWD:/usr/local/IA.BAK/pushed.sh"
+ & Cron.niceJob "shardstats" (Cron.Times "*/30 * * * *") (User "root") "/"
+ "/usr/local/IA.BAK/shardstats-all"
+ & Cron.niceJob "shardmaint" Cron.Daily (User "root") "/"
+ "/usr/local/IA.BAK/shardmaint-fast; /usr/local/IA.BAK/shardmaint"
+ & Apt.installed ["git-annex"]
+ & Apt.installed ["libmail-sendmail-perl"]
+ & Cron.niceJob "expireemailer" Cron.Daily (User "root")
+ "/usr/local/IA.BAK"
+ "./expireemailer"
+
+registrationServer :: [Host] -> Property (HasInfo + DebianLike)
+registrationServer knownhosts = propertyList "iabak registration server" $ props
+ & User.accountFor (User "registrar")
+ & Ssh.userKeys (User "registrar") (Context "IA.bak.users.git") sshKeys
+ & Ssh.knownHost knownhosts "gitlab.com" (User "registrar")
+ & Git.cloned (User "registrar") repo "/home/registrar/IA.BAK" (Just "server")
+ & Git.cloned (User "registrar") userrepo "/home/registrar/users" (Just "master")
+ & Apt.serviceInstalledRunning "apache2"
+ & Apt.installed ["perl", "perl-modules"]
+ & link `File.isSymlinkedTo` File.LinkTarget "/home/registrar/IA.BAK/registrar/register.cgi"
+ & cmdProperty "chown" ["-h", "registrar:registrar", link]
+ `changesFile` link
+ & File.containsLine "/etc/sudoers" "www-data ALL=(registrar) NOPASSWD:/home/registrar/IA.BAK/registrar/register.pl"
+ & Apt.installed ["kgb-client"]
+ & File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf" anyContext
+ `requires` File.dirExists "/etc/kgb-bot/"
+ where
+ link = "/usr/lib/cgi-bin/register.cgi"
+
+sshKeys :: [(SshKeyType, Ssh.PubKeyText)]
+sshKeys =
+ [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCoiE+CPiIQyfWnl/E9iKG3eo4QzlH30vi7xAgKolGaTu6qKy4XPtl+8MNm2Dqn9QEYRVyyOT/XH0yP5dRc6uyReT8dBy03MmLkVbj8Q+nKCz5YOMTxrY3sX6RRXU1zVGjeVd0DtC+rKRT7reoCxef42LAJTm8nCyZu/enAuso5qHqBbqulFz2YXEKfU1SEEXLawtvgGck1KmCyg+pqazeI1eHWXrojQf5isTBKfPQLWVppBkWAf5cA4wP5U1vN9dVirIdw66ds1M8vnGlkTBjxP/HLGBWGYhZHE7QXjXRsk2RIXlHN9q6GdNu8+F3HXS22mst47E4UAeRoiXSMMtF5")
+ ]
+
+graphiteServer :: Property (HasInfo + DebianLike)
+graphiteServer = propertyList "iabak graphite server" $ props
+ & Apt.serviceInstalledRunning "apache2"
+ & Apt.installed ["libapache2-mod-wsgi", "graphite-carbon", "graphite-web"]
+ & File.hasContent "/etc/carbon/storage-schemas.conf"
+ [ "[carbon]"
+ , "pattern = ^carbon\\."
+ , "retentions = 60:90d"
+ , "[iabak-connections]"
+ , "pattern = ^iabak\\.shardstats\\.connections"
+ , "retentions = 1h:1y,3h:10y"
+ , "[iabak-default]"
+ , "pattern = ^iabak\\."
+ , "retentions = 10m:30d,1h:1y,3h:10y"
+ , "[default_1min_for_1day]"
+ , "pattern = .*"
+ , "retentions = 60s:1d"
+ ]
+ & graphiteCSRF
+ & cmdProperty "graphite-manage" ["syncdb", "--noinput"]
+ `assume` MadeChange
+ `flagFile` "/etc/flagFiles/graphite-syncdb"
+ & cmdProperty "graphite-manage" ["createsuperuser", "--noinput", "--username=joey", "--email=joey@localhost"]
+ `assume` MadeChange
+ `flagFile` "/etc/flagFiles/graphite-user-joey"
+ & cmdProperty "graphite-manage" ["createsuperuser", "--noinput", "--username=db48x", "--email=db48x@localhost"]
+ `assume` MadeChange
+ `flagFile` "/etc/flagFiles/graphite-user-db48x"
+ -- TODO: deal with passwords somehow
+ & File.ownerGroup "/var/lib/graphite/graphite.db" (User "_graphite") (Group "_graphite")
+ & "/etc/apache2/ports.conf" `File.containsLine` "Listen 8080"
+ `onChange` Apache.restarted
+ & Apache.siteEnabled "iabak-graphite-web"
+ [ "<VirtualHost *:8080>"
+ , " WSGIDaemonProcess _graphite processes=5 threads=5 display-name='%{GROUP}' inactivity-timeout=120 user=_graphite group=_graphite"
+ , " WSGIProcessGroup _graphite"
+ , " WSGIImportScript /usr/share/graphite-web/graphite.wsgi process-group=_graphite application-group=%{GLOBAL}"
+ , " WSGIScriptAlias / /usr/share/graphite-web/graphite.wsgi"
+ , " Alias /content/ /usr/share/graphite-web/static/"
+ , " <Location \"/content/\">"
+ , " SetHandler None"
+ , " </Location>"
+ , " ErrorLog ${APACHE_LOG_DIR}/graphite-web_error.log"
+ , " LogLevel warn"
+ , " CustomLog ${APACHE_LOG_DIR}/graphite-web_access.log combined"
+ , "</VirtualHost>"
+ ]
+ where
+ graphiteCSRF :: Property (HasInfo + DebianLike)
+ graphiteCSRF = withPrivData (Password "csrf-token") (Context "iabak.archiveteam.org") $
+ \gettoken -> property' "graphite-web CSRF token" $ \w ->
+ gettoken $ \token -> ensureProperty w $ File.containsLine
+ "/etc/graphite/local_settings.py" ("SECRET_KEY = '"++ privDataVal token ++"'")
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index bd9e01e2..a6cb3794 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -1,11 +1,14 @@
--- | Specific configuation for Joey Hess's sites. Probably not useful to
+-- | Specific configuration for Joey Hess's sites. Probably not useful to
-- others except as an example.
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
module Propellor.Property.SiteSpecific.JoeySites where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
+import qualified Propellor.Property.ConfFile as ConfFile
import qualified Propellor.Property.Gpg as Gpg
import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Git as Git
@@ -15,30 +18,92 @@ import qualified Propellor.Property.User as User
import qualified Propellor.Property.Obnam as Obnam
import qualified Propellor.Property.Apache as Apache
import qualified Propellor.Property.Postfix as Postfix
-import Utility.SafeCommand
+import qualified Propellor.Property.Systemd as Systemd
+import qualified Propellor.Property.Fail2Ban as Fail2Ban
+import qualified Propellor.Property.LetsEncrypt as LetsEncrypt
import Utility.FileMode
-import Utility.Path
import Data.List
import System.Posix.Files
import Data.String.Utils
-oldUseNetServer :: [Host] -> Property
-oldUseNetServer hosts = propertyList ("olduse.net server")
- [ oldUseNetInstalled "oldusenet-server"
- , Obnam.latestVersion
- , Obnam.backup datadir "33 4 * * *"
- [ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
- , "--client-name=spool"
- ] Obnam.OnlyClient
- `requires` Ssh.keyImported SshRsa "root" (Context "olduse.net")
- `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
- , check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) $
- property "olduse.net spool in place" $ makeChange $ do
- removeDirectoryRecursive newsspool
- createSymbolicLink (datadir </> "news") newsspool
- , Apt.installed ["leafnode"]
- , "/etc/news/leafnode/config" `File.hasContent`
+scrollBox :: Property (HasInfo + DebianLike)
+scrollBox = propertyList "scroll server" $ props
+ & User.accountFor (User "scroll")
+ & Git.cloned (User "scroll") "git://git.kitenet.net/scroll" (d </> "scroll") Nothing
+ & Apt.installed ["ghc", "make", "cabal-install", "libghc-vector-dev",
+ "libghc-bytestring-dev", "libghc-mtl-dev", "libghc-ncurses-dev",
+ "libghc-random-dev", "libghc-monad-loops-dev", "libghc-text-dev",
+ "libghc-ifelse-dev", "libghc-case-insensitive-dev",
+ "libghc-data-default-dev", "libghc-optparse-applicative-dev"]
+ & userScriptProperty (User "scroll")
+ [ "cd " ++ d </> "scroll"
+ , "git pull"
+ , "cabal configure"
+ , "make"
+ ]
+ `assume` MadeChange
+ & s `File.hasContent`
+ [ "#!/bin/sh"
+ , "set -e"
+ , "echo Preparing to run scroll!"
+ , "cd " ++ d
+ , "mkdir -p tmp"
+ , "TMPDIR= t=$(tempfile -d tmp)"
+ , "export t"
+ , "rm -f \"$t\""
+ , "mkdir \"$t\""
+ , "cd \"$t\""
+ , "echo"
+ , "echo Note that games on this server are time-limited to 2 hours"
+ , "echo 'Need more time? Run scroll locally instead!'"
+ , "echo"
+ , "echo Press Enter to start the game."
+ , "read me"
+ , "SHELL=/bin/sh script --timing=timing -c " ++ g
+ ] `onChange` (s `File.mode` (combineModes (ownerWriteMode:readModes ++ executeModes)))
+ & g `File.hasContent`
+ [ "#!/bin/sh"
+ , "if ! timeout --kill-after 1m --foreground 2h ../../scroll/scroll; then"
+ , "echo Scroll seems to have ended unexpectedly. Possibly a bug.."
+ , "else"
+ , "echo Thanks for playing scroll! https://joeyh.name/code/scroll/"
+ , "fi"
+ , "echo Your game was recorded, as ID:$(basename \"$t\")"
+ , "echo if you would like to talk about how it went, email scroll@joeyh.name"
+ , "echo 'or, type comments below (finish with a dot on its own line)'"
+ , "echo"
+ , "echo Your comments:"
+ , "timeout --kill-after 1m --foreground 2h mail -E -s \"scroll test $t\" joey@kitenet.net"
+ ] `onChange` (g `File.mode` (combineModes (ownerWriteMode:readModes ++ executeModes)))
+ & Apt.installed ["bsd-mailx"]
+ -- prevent port forwarding etc by not letting scroll log in via ssh
+ & Ssh.sshdConfig `File.containsLine` ("DenyUsers scroll")
+ `onChange` Ssh.restarted
+ & User.shellSetTo (User "scroll") s
+ & User.hasPassword (User "scroll")
+ & Apt.serviceInstalledRunning "telnetd"
+ & Apt.installed ["shellinabox"]
+ & File.hasContent "/etc/default/shellinabox"
+ [ "# Deployed by propellor"
+ , "SHELLINABOX_DAEMON_START=1"
+ , "SHELLINABOX_PORT=4242"
+ , "SHELLINABOX_ARGS=\"--disable-ssl --no-beep --service=:scroll:scroll:" ++ d ++ ":" ++ s ++ "\""
+ ]
+ `onChange` Service.restarted "shellinabox"
+ & Service.running "shellinabox"
+ where
+ d = "/home/scroll"
+ s = d </> "login.sh"
+ g = d </> "game.sh"
+
+oldUseNetServer :: [Host] -> Property (HasInfo + DebianLike)
+oldUseNetServer hosts = propertyList "olduse.net server" $ props
+ & Apt.installed ["leafnode"]
+ & oldUseNetInstalled "oldusenet-server"
+ & oldUseNetBackup
+ & spoolsymlink
+ & "/etc/news/leafnode/config" `File.hasContent`
[ "# olduse.net configuration (deployed by propellor)"
, "expire = 1000000" -- no expiry via texpire
, "server = " -- no upstream server
@@ -46,17 +111,22 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
, "allowSTRANGERS = 42" -- lets anyone connect
, "nopost = 1" -- no new posting (just gather them)
]
- , "/etc/hosts.deny" `File.lacksLine` "leafnode: ALL"
- , Apt.serviceInstalledRunning "openbsd-inetd"
- , File.notPresent "/etc/cron.daily/leafnode"
- , File.notPresent "/etc/cron.d/leafnode"
- , Cron.niceJob "oldusenet-expire" "11 1 * * *" "news" newsspool $ intercalate ";"
+ & "/etc/hosts.deny" `File.lacksLine` "leafnode: ALL"
+ & Apt.serviceInstalledRunning "openbsd-inetd"
+ & File.notPresent "/etc/cron.daily/leafnode"
+ & File.notPresent "/etc/cron.d/leafnode"
+ & Cron.niceJob "oldusenet-expire" (Cron.Times "11 1 * * *") (User "news") newsspool expirecommand
+ & Cron.niceJob "oldusenet-uucp" (Cron.Times "*/5 * * * *") (User "news") "/" uucpcommand
+ & Apache.siteEnabled "nntp.olduse.net" nntpcfg
+ where
+ newsspool = "/var/spool/news"
+ datadir = "/var/spool/oldusenet"
+ expirecommand = intercalate ";"
[ "find \\( -path ./out.going -or -path ./interesting.groups -or -path './*/.overview' \\) -prune -or -type f -ctime +60 -print | xargs --no-run-if-empty rm"
, "find -type d -empty | xargs --no-run-if-empty rmdir"
]
- , Cron.niceJob "oldusenet-uucp" "*/5 * * * *" "news" "/" $
- "/usr/bin/uucp " ++ datadir
- , toProp $ Apache.siteEnabled "nntp.olduse.net" $ apachecfg "nntp.olduse.net" False
+ uucpcommand = "/usr/bin/uucp " ++ datadir
+ nntpcfg = apachecfg "nntp.olduse.net"
[ " DocumentRoot " ++ datadir ++ "/"
, " <Directory " ++ datadir ++ "/>"
, " Options Indexes FollowSymlinks"
@@ -64,23 +134,39 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
, Apache.allowAll
, " </Directory>"
]
- ]
- where
- newsspool = "/var/spool/news"
- datadir = "/var/spool/oldusenet"
-
-oldUseNetShellBox :: Property
-oldUseNetShellBox = propertyList "olduse.net shellbox"
- [ oldUseNetInstalled "oldusenet"
- , Service.running "shellinabox"
- ]
+
+ spoolsymlink :: Property UnixLike
+ spoolsymlink = check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool)
+ (property "olduse.net spool in place" $ makeChange $ do
+ removeDirectoryRecursive newsspool
+ createSymbolicLink (datadir </> "news") newsspool
+ )
-oldUseNetInstalled :: Apt.Package -> Property
+ oldUseNetBackup :: Property (HasInfo + DebianLike)
+ oldUseNetBackup = Obnam.backup datadir (Cron.Times "33 4 * * *")
+ [ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
+ , "--client-name=spool"
+ , "--ssh-key=" ++ keyfile
+ , Obnam.keepParam [Obnam.KeepDays 30]
+ ] Obnam.OnlyClient
+ `requires` Ssh.userKeyAt (Just keyfile)
+ (User "root")
+ (Context "olduse.net")
+ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD")
+ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
+ keyfile = "/root/.ssh/olduse.net.key"
+
+oldUseNetShellBox :: Property DebianLike
+oldUseNetShellBox = propertyList "olduse.net shellbox" $ props
+ & oldUseNetInstalled "oldusenet"
+ & Service.running "shellinabox"
+
+oldUseNetInstalled :: Apt.Package -> Property DebianLike
oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
- propertyList ("olduse.net " ++ pkg)
- [ Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
+ propertyList ("olduse.net " ++ pkg) $ props
+ & Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
`describe` "olduse.net build deps"
- , scriptProperty
+ & scriptProperty
[ "rm -rf /root/tmp/oldusenet" -- idenpotency
, "git clone git://olduse.net/ /root/tmp/oldusenet/source"
, "cd /root/tmp/oldusenet/source/"
@@ -88,78 +174,70 @@ oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
, "dpkg -i ../" ++ pkg ++ "_*.deb || true"
, "apt-get -fy install" -- dependencies
, "rm -rf /root/tmp/oldusenet"
- -- screen fails unless the directory has this mode.
- -- not sure what's going on.
- , "chmod 777 /var/run/screen"
- ] `describe` "olduse.net built"
- ]
-
-
-kgbServer :: Property
-kgbServer = propertyList desc
- [ withOS desc $ \o -> case o of
+ ]
+ `assume` MadeChange
+ `describe` "olduse.net built"
+
+kgbServer :: Property (HasInfo + Debian)
+kgbServer = propertyList desc $ props
+ & installed
+ & File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
+ `onChange` Service.restarted "kgb-bot"
+ where
+ desc = "kgb.kitenet.net setup"
+ installed :: Property Debian
+ installed = withOS desc $ \w o -> case o of
(Just (System (Debian Unstable) _)) ->
- ensureProperty $ propertyList desc
- [ Apt.serviceInstalledRunning "kgb-bot"
- , "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
+ ensureProperty w $ propertyList desc $ props
+ & Apt.serviceInstalledRunning "kgb-bot"
+ & "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
`describe` "kgb bot enabled"
`onChange` Service.running "kgb-bot"
- ]
_ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)"
- , File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
- `onChange` Service.restarted "kgb-bot"
- ]
- where
- desc = "kgb.kitenet.net setup"
-mumbleServer :: [Host] -> Property
-mumbleServer hosts = combineProperties hn
- [ Apt.serviceInstalledRunning "mumble-server"
- , Obnam.latestVersion
- , Obnam.backup "/var/lib/mumble-server" "55 5 * * *"
- [ "--repository=sftp://joey@usbackup.kitenet.net/~/lib/backup/" ++ hn ++ ".obnam"
+mumbleServer :: [Host] -> Property (HasInfo + DebianLike)
+mumbleServer hosts = combineProperties hn $ props
+ & Apt.serviceInstalledRunning "mumble-server"
+ & Obnam.backup "/var/lib/mumble-server" (Cron.Times "55 5 * * *")
+ [ "--repository=sftp://2318@usw-s002.rsync.net/~/" ++ hn ++ ".obnam"
+ , "--ssh-key=" ++ sshkey
, "--client-name=mumble"
+ , Obnam.keepParam [Obnam.KeepDays 30]
] Obnam.OnlyClient
- `requires` Ssh.keyImported SshRsa "root" (Context hn)
- `requires` Ssh.knownHost hosts "usbackup.kitenet.net" "root"
- , trivial $ cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]
- ]
+ `requires` Ssh.userKeyAt (Just sshkey)
+ (User "root")
+ (Context hn)
+ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDSXXSM3mM8SNu+qel9R/LkDIkjpV3bfpUtRtYv2PTNqicHP+DdoThrr0ColFCtLH+k2vQJvR2n8uMzHn53Dq2IO3TtD27+7rJSsJwAZ8oftNzuTir8IjAwX5g6JYJs+L0Ny4RB0ausd+An0k/CPMRl79zKxpZd2MBMDNXt8hyqu0vS0v1ohq5VBEVhBBvRvmNQvWOCj7PdrKQXpUBHruZOeVVEdUUXZkVc1H0t7LVfJnE+nGKyWbw2jM+7r3Rn5Semc4R1DxsfaF8lKkZyE88/5uZQ/ddomv8ptz6YZ5b+Bg6wfooWPC3RWAALjxnHaC2yN1VONAvHmT0uNn1o6v0b")
+ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
+ & cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]
+ `assume` NoChange
where
hn = "mumble.debian.net"
-
-obnamLowMem :: Property
-obnamLowMem = combineProperties "obnam tuned for low memory use"
- [ Obnam.latestVersion
- , "/etc/obnam.conf" `File.containsLines`
- [ "[config]"
- , "# Suggested by liw to keep Obnam memory consumption down (at some speed cost)."
- , "upload-queue-size = 128"
- , "lru-size = 128"
- ]
- ]
+ sshkey = "/root/.ssh/mumble.debian.net.key"
-- git.kitenet.net and git.joeyh.name
-gitServer :: [Host] -> Property
-gitServer hosts = propertyList "git.kitenet.net setup"
- [ Obnam.latestVersion
- , Obnam.backup "/srv/git" "33 3 * * *"
+gitServer :: [Host] -> Property (HasInfo + DebianLike)
+gitServer hosts = propertyList "git.kitenet.net setup" $ props
+ & Obnam.backupEncrypted "/srv/git" (Cron.Times "33 3 * * *")
[ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net"
- , "--encrypt-with=1B169BE1"
+ , "--ssh-key=" ++ sshkey
, "--client-name=wren" -- historical
- ] Obnam.OnlyClient
- `requires` Gpg.keyImported "1B169BE1" "root"
- `requires` Ssh.keyImported SshRsa "root" (Context "git.kitenet.net")
- `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
- `requires` Ssh.authorizedKeys "family" (Context "git.kitenet.net")
- `requires` User.accountFor "family"
- , Apt.installed ["git", "rsync", "gitweb"]
- -- backport avoids channel flooding on branch merge
- , Apt.installedBackport ["kgb-client"]
- -- backport supports ssh event notification
- , Apt.installedBackport ["git-annex"]
- , File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf" anyContext
- , toProp $ Git.daemonRunning "/srv/git"
- , "/etc/gitweb.conf" `File.containsLines`
+ , Obnam.keepParam [Obnam.KeepDays 30]
+ ] Obnam.OnlyClient (Gpg.GpgKeyId "1B169BE1")
+ `requires` Ssh.userKeyAt (Just sshkey)
+ (User "root")
+ (Context "git.kitenet.net")
+ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD")
+ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
+ `requires` Ssh.authorizedKeys (User "family") (Context "git.kitenet.net")
+ `requires` User.accountFor (User "family")
+ & Apt.installed ["git", "rsync", "gitweb"]
+ & Apt.installed ["git-annex"]
+ & Apt.installed ["kgb-client"]
+ & File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf" anyContext
+ `requires` File.dirExists "/etc/kgb-bot/"
+ & Git.daemonRunning "/srv/git"
+ & "/etc/gitweb.conf" `File.containsLines`
[ "$projectroot = '/srv/git';"
, "@git_base_url_list = ('git://git.kitenet.net', 'http://git.kitenet.net/git', 'https://git.kitenet.net/git', 'ssh://git.kitenet.net/srv/git');"
, "# disable snapshot download; overloads server"
@@ -167,21 +245,22 @@ gitServer hosts = propertyList "git.kitenet.net setup"
]
`describe` "gitweb configured"
-- Repos push on to github.
- , Ssh.knownHost hosts "github.com" "joey"
+ & Ssh.knownHost hosts "github.com" (User "joey")
-- I keep the website used for gitweb checked into git..
- , Git.cloned "root" "/srv/git/joey/git.kitenet.net.git" "/srv/web/git.kitenet.net" Nothing
- , website "git.kitenet.net"
- , website "git.joeyh.name"
- , toProp $ Apache.modEnabled "cgi"
- ]
+ & Git.cloned (User "root") "/srv/git/joey/git.kitenet.net.git" "/srv/web/git.kitenet.net" Nothing
+ & website "git.kitenet.net"
+ & website "git.joeyh.name"
+ & Apache.modEnabled "cgi"
where
- website hn = toProp $ Apache.siteEnabled hn $ apachecfg hn True
- [ " DocumentRoot /srv/web/git.kitenet.net/"
+ sshkey = "/root/.ssh/git.kitenet.net.key"
+ website hn = Apache.httpsVirtualHost' hn "/srv/web/git.kitenet.net/" letos
+ [ Apache.iconDir
, " <Directory /srv/web/git.kitenet.net/>"
, " Options Indexes ExecCGI FollowSymlinks"
, " AllowOverride None"
, " AddHandler cgi-script .cgi"
, " DirectoryIndex index.cgi"
+ , Apache.allowAll
, " </Directory>"
, ""
, " ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/"
@@ -194,214 +273,238 @@ gitServer hosts = propertyList "git.kitenet.net setup"
type AnnexUUID = String
-- | A website, with files coming from a git-annex repository.
-annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property
-annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex")
- [ Git.cloned "joey" origin dir Nothing
+annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property (HasInfo + DebianLike)
+annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex") $ props
+ & Git.cloned (User "joey") origin dir Nothing
`onChange` setup
- , postupdatehook `File.hasContent`
+ & alias hn
+ & postupdatehook `File.hasContent`
[ "#!/bin/sh"
, "exec git update-server-info"
] `onChange`
(postupdatehook `File.mode` (combineModes (ownerWriteMode:readModes ++ executeModes)))
- , setupapache
- ]
+ & setupapache
where
dir = "/srv/web/" ++ hn
postupdatehook = dir </> ".git/hooks/post-update"
- setup = userScriptProperty "joey" setupscript
+ setup = userScriptProperty (User "joey") setupscript
+ `assume` MadeChange
setupscript =
[ "cd " ++ shellEscape dir
- , "git config annex.uuid " ++ shellEscape uuid
+ , "git annex reinit " ++ shellEscape uuid
] ++ map addremote remotes ++
[ "git annex get"
+ , "git update-server-info"
]
addremote (name, url) = "git remote add " ++ shellEscape name ++ " " ++ shellEscape url
- setupapache = toProp $ Apache.siteEnabled hn $ apachecfg hn True $
+ setupapache = Apache.httpsVirtualHost' hn dir letos
[ " ServerAlias www."++hn
- , ""
- , " DocumentRoot /srv/web/"++hn
- , " <Directory /srv/web/"++hn++">"
- , " Options FollowSymLinks"
- , " AllowOverride None"
- , " </Directory>"
- , " <Directory /srv/web/"++hn++">"
+ , Apache.iconDir
+ , " <Directory "++dir++">"
, " Options Indexes FollowSymLinks ExecCGI"
, " AllowOverride None"
, " AddHandler cgi-script .cgi"
, " DirectoryIndex index.html index.cgi"
- , " Order allow,deny"
- , " allow from all"
+ , Apache.allowAll
, " </Directory>"
]
-apachecfg :: HostName -> Bool -> Apache.ConfigFile -> Apache.ConfigFile
-apachecfg hn withssl middle
- | withssl = vhost False ++ vhost True
- | otherwise = vhost False
- where
- vhost ssl =
- [ "<VirtualHost *:"++show port++">"
- , " ServerAdmin grue@joeyh.name"
- , " ServerName "++hn++":"++show port
- ]
- ++ mainhttpscert ssl
- ++ middle ++
- [ ""
- , " ErrorLog /var/log/apache2/error.log"
- , " LogLevel warn"
- , " CustomLog /var/log/apache2/access.log combined"
- , " ServerSignature On"
- , " "
- , " <Directory \"/usr/share/apache2/icons\">"
- , " Options Indexes MultiViews"
- , " AllowOverride None"
- , " Order allow,deny"
- , " Allow from all"
- , " </Directory>"
- , "</VirtualHost>"
- ]
- where
- port = if ssl then 443 else 80 :: Int
-
-mainhttpscert :: Bool -> Apache.ConfigFile
-mainhttpscert False = []
-mainhttpscert True =
- [ " SSLEngine on"
- , " SSLCertificateFile /etc/ssl/certs/web.pem"
- , " SSLCertificateKeyFile /etc/ssl/private/web.pem"
- , " SSLCertificateChainFile /etc/ssl/certs/startssl.pem"
+letos :: LetsEncrypt.AgreeTOS
+letos = LetsEncrypt.AgreeTOS (Just "id@joeyh.name")
+
+apacheSite :: HostName -> Apache.ConfigFile -> RevertableProperty DebianLike DebianLike
+apacheSite hn middle = Apache.siteEnabled hn $ apachecfg hn middle
+
+apachecfg :: HostName -> Apache.ConfigFile -> Apache.ConfigFile
+apachecfg hn middle =
+ [ "<VirtualHost *:"++show port++">"
+ , " ServerAdmin grue@joeyh.name"
+ , " ServerName "++hn++":"++show port
]
+ ++ middle ++
+ [ ""
+ , " ErrorLog /var/log/apache2/error.log"
+ , " LogLevel warn"
+ , " CustomLog /var/log/apache2/access.log combined"
+ , " ServerSignature On"
+ , " "
+ , Apache.iconDir
+ , "</VirtualHost>"
+ ]
+ where
+ port = 80 :: Int
-gitAnnexDistributor :: Property
-gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer"
- [ Apt.installed ["rsync"]
- , File.hasPrivContent "/etc/rsyncd.conf" (Context "git-annex distributor")
+gitAnnexDistributor :: Property (HasInfo + DebianLike)
+gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" $ props
+ & Apt.installed ["rsync"]
+ & File.hasPrivContent "/etc/rsyncd.conf" (Context "git-annex distributor")
`onChange` Service.restarted "rsync"
- , File.hasPrivContent "/etc/rsyncd.secrets" (Context "git-annex distributor")
+ & File.hasPrivContent "/etc/rsyncd.secrets" (Context "git-annex distributor")
`onChange` Service.restarted "rsync"
- , "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true"
+ & "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true"
`onChange` Service.running "rsync"
- , endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild"
- , endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/x86_64-apple-mavericks"
+ & Systemd.enabled "rsync"
+ & endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild"
+ & endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/x86_64-apple-yosemite"
+ & endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/windows"
-- git-annex distribution signing key
- , Gpg.keyImported "89C809CB" "joey"
- ]
+ & Gpg.keyImported (Gpg.GpgKeyId "89C809CB") (User "joey")
where
- endpoint d = combineProperties ("endpoint " ++ d)
- [ File.dirExists d
- , File.ownerGroup d "joey" "joey"
- ]
+ endpoint d = combineProperties ("endpoint " ++ d) $ props
+ & File.dirExists d
+ & File.ownerGroup d (User "joey") (Group "joey")
+
+downloads :: [Host] -> Property (HasInfo + DebianLike)
+downloads hosts = annexWebSite "/srv/git/downloads.git"
+ "downloads.kitenet.net"
+ "840760dc-08f0-11e2-8c61-576b7e66acfd"
+ [("eubackup", "ssh://eubackup.kitenet.net/~/lib/downloads/")]
+ `requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "joey")
+
+tmp :: Property (HasInfo + DebianLike)
+tmp = propertyList "tmp.kitenet.net" $ props
+ & annexWebSite "/srv/git/joey/tmp.git"
+ "tmp.kitenet.net"
+ "26fd6e38-1226-11e2-a75f-ff007033bdba"
+ []
+ & twitRss
+ & pumpRss
-- Twitter, you kill us.
-twitRss :: Property
-twitRss = combineProperties "twitter rss"
- [ Git.cloned "joey" "git://git.kitenet.net/twitrss.git" dir Nothing
- , check (not <$> doesFileExist (dir </> "twitRss")) $
- userScriptProperty "joey"
- [ "cd " ++ dir
- , "ghc --make twitRss"
- ]
- `requires` Apt.installed
- [ "libghc-xml-dev"
- , "libghc-feed-dev"
- , "libghc-tagsoup-dev"
- ]
- , feed "http://twitter.com/search/realtime?q=git-annex" "git-annex-twitter"
- , feed "http://twitter.com/search/realtime?q=olduse+OR+git-annex+OR+debhelper+OR+etckeeper+OR+ikiwiki+-ashley_ikiwiki" "twittergrep"
- ]
+twitRss :: Property DebianLike
+twitRss = combineProperties "twitter rss" $ props
+ & Git.cloned (User "joey") "git://git.kitenet.net/twitrss.git" dir Nothing
+ & check (not <$> doesFileExist (dir </> "twitRss")) compiled
+ & feed "http://twitter.com/search/realtime?q=git-annex" "git-annex-twitter"
+ & feed "http://twitter.com/search/realtime?q=olduse+OR+git-annex+OR+debhelper+OR+etckeeper+OR+ikiwiki+-ashley_ikiwiki" "twittergrep"
where
dir = "/srv/web/tmp.kitenet.net/twitrss"
- crontime = "15 * * * *"
- feed url desc = Cron.job desc crontime "joey" dir $
+ crontime = Cron.Times "15 * * * *"
+ feed url desc = Cron.job desc crontime (User "joey") dir $
"./twitRss " ++ shellEscape url ++ " > " ++ shellEscape ("../" ++ desc ++ ".rss")
+ compiled = userScriptProperty (User "joey")
+ [ "cd " ++ dir
+ , "ghc --make twitRss"
+ ]
+ `assume` NoChange
+ `requires` Apt.installed
+ [ "libghc-xml-dev"
+ , "libghc-feed-dev"
+ , "libghc-tagsoup-dev"
+ ]
-- Work around for expired ssl cert.
-pumpRss :: Property
-pumpRss = Cron.job "pump rss" "15 * * * *" "joey" "/srv/web/tmp.kitenet.net/"
- "wget https://pump2rss.com/feed/joeyh@identi.ca.atom -O pump.atom --no-check-certificate 2>/dev/null"
-
-ircBouncer :: Property
-ircBouncer = propertyList "IRC bouncer"
- [ Apt.installed ["znc"]
- , User.accountFor "znc"
- , File.dirExists (parentDir conf)
- , File.hasPrivContent conf anyContext
- , File.ownerGroup conf "znc" "znc"
- , Cron.job "znconboot" "@reboot" "znc" "~" "znc"
+pumpRss :: Property DebianLike
+pumpRss = Cron.job "pump rss" (Cron.Times "15 * * * *") (User "joey") "/srv/web/tmp.kitenet.net/"
+ "wget https://rss.io.jpope.org/feed/joeyh@identi.ca.atom -O pump.atom.new --no-check-certificate 2>/dev/null; sed 's/ & / /g' pump.atom.new > pump.atom"
+
+ircBouncer :: Property (HasInfo + DebianLike)
+ircBouncer = propertyList "IRC bouncer" $ props
+ & Apt.installed ["znc"]
+ & User.accountFor (User "znc")
+ & File.dirExists (takeDirectory conf)
+ & File.hasPrivContent conf anyContext
+ & File.ownerGroup conf (User "znc") (Group "znc")
+ & Cron.job "znconboot" (Cron.Times "@reboot") (User "znc") "~" "znc"
-- ensure running if it was not already
- , trivial $ userScriptProperty "znc" ["znc || true"]
+ & userScriptProperty (User "znc") ["znc || true"]
+ `assume` NoChange
`describe` "znc running"
- ]
where
conf = "/home/znc/.znc/configs/znc.conf"
-kiteShellBox :: Property
-kiteShellBox = propertyList "kitenet.net shellinabox"
- [ Apt.installed ["shellinabox"]
- , File.hasContent "/etc/default/shellinabox"
+kiteShellBox :: Property DebianLike
+kiteShellBox = propertyList "kitenet.net shellinabox" $ props
+ & Apt.installed ["openssl", "shellinabox", "openssh-client"]
+ & File.hasContent "/etc/default/shellinabox"
[ "# Deployed by propellor"
, "SHELLINABOX_DAEMON_START=1"
, "SHELLINABOX_PORT=443"
, "SHELLINABOX_ARGS=\"--no-beep --service=/:SSH:kitenet.net\""
]
`onChange` Service.restarted "shellinabox"
- , Service.running "shellinabox"
- ]
-
-githubBackup :: Property
-githubBackup = propertyList "github-backup box"
- [ Apt.installed ["github-backup", "moreutils"]
- , let f = "/home/joey/.github-keys"
- in File.hasPrivContent f anyContext
- `onChange` File.ownerGroup f "joey" "joey"
- , Cron.niceJob "github-backup run" "30 4 * * *" "joey"
- "/home/joey/lib/backup" $ intercalate "&&"
- [ "mkdir -p github"
- , "cd github"
- , ". $HOME/.github-keys && github-backup joeyh"
- ]
+ & Service.running "shellinabox"
+
+githubBackup :: Property (HasInfo + DebianLike)
+githubBackup = propertyList "github-backup box" $ props
+ & Apt.installed ["github-backup", "moreutils"]
+ & githubKeys
+ & Cron.niceJob "github-backup run" (Cron.Times "30 4 * * *") (User "joey")
+ "/home/joey/lib/backup" backupcmd
+ & Cron.niceJob "gitriddance" (Cron.Times "30 4 * * *") (User "joey")
+ "/home/joey/lib/backup" gitriddancecmd
+ where
+ backupcmd = intercalate "&&" $
+ [ "mkdir -p github"
+ , "cd github"
+ , ". $HOME/.github-keys"
+ , "github-backup joeyh"
+ ]
+ gitriddancecmd = intercalate "&&" $
+ [ "cd github"
+ , ". $HOME/.github-keys"
+ ] ++ map gitriddance githubMirrors
+ gitriddance (r, msg) = "(cd " ++ r ++ " && gitriddance " ++ shellEscape msg ++ ")"
+
+githubKeys :: Property (HasInfo + UnixLike)
+githubKeys =
+ let f = "/home/joey/.github-keys"
+ in File.hasPrivContent f anyContext
+ `onChange` File.ownerGroup f (User "joey") (Group "joey")
+
+
+-- these repos are only mirrored on github, I don't want
+-- all the proprietary features
+githubMirrors :: [(String, String)]
+githubMirrors =
+ [ ("ikiwiki", plzuseurl "http://ikiwiki.info/todo/")
+ , ("git-annex", plzuseurl "http://git-annex.branchable.com/todo/")
+ , ("myrepos", plzuseurl "http://myrepos.branchable.com/todo/")
+ , ("propellor", plzuseurl "http://propellor.branchable.com/todo/")
+ , ("etckeeper", plzuseurl "http://etckeeper.branchable.com/todo/")
]
+ where
+ plzuseurl u = "Please submit changes to " ++ u ++ " instead of using github pull requests, which are not part of my workflow. Just open a todo item there and link to a git repository containing your changes. Did you know, git is a distributed system? The git repository doesn't even need to be on github! Please send any complaints to Github; they don't allow turning off pull requests or redirecting them elsewhere. -- A robot acting on behalf of Joey Hess"
-rsyncNetBackup :: [Host] -> Property
-rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" "30 5 * * *"
- "joey" "/home/joey/lib/backup" "mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net"
- `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "joey"
+rsyncNetBackup :: [Host] -> Property DebianLike
+rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" (Cron.Times "30 5 * * *")
+ (User "joey") "/home/joey/lib/backup" "mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net"
+ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "joey")
-backupsBackedupTo :: [Host] -> HostName -> FilePath -> Property
-backupsBackedupTo hosts desthost destdir = Cron.niceJob desc
- "1 1 * * 3" "joey" "/" cmd
- `requires` Ssh.knownHost hosts desthost "joey"
+backupsBackedupFrom :: [Host] -> HostName -> FilePath -> Property DebianLike
+backupsBackedupFrom hosts srchost destdir = Cron.niceJob desc
+ (Cron.Times "@reboot") (User "joey") "/" cmd
+ `requires` Ssh.knownHost hosts srchost (User "joey")
where
- desc = "backups copied to " ++ desthost ++ " weekly"
- cmd = "rsync -az --delete /home/joey/lib/backup " ++ desthost ++ ":" ++ destdir
+ desc = "backups copied from " ++ srchost ++ " on boot"
+ cmd = "sleep 30m && rsync -az --bwlimit=300K --partial --delete " ++ srchost ++ ":lib/backup/ " ++ destdir </> srchost
-obnamRepos :: [String] -> Property
-obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)
- (mkbase : map mkrepo rs)
+obnamRepos :: [String] -> Property UnixLike
+obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs) $
+ toProps (mkbase : map mkrepo rs)
where
mkbase = mkdir "/home/joey/lib/backup"
`requires` mkdir "/home/joey/lib"
mkrepo r = mkdir ("/home/joey/lib/backup/" ++ r ++ ".obnam")
mkdir d = File.dirExists d
- `before` File.ownerGroup d "joey" "joey"
+ `before` File.ownerGroup d (User "joey") (Group "joey")
-podcatcher :: Property
-podcatcher = Cron.niceJob "podcatcher run hourly" "55 * * * *"
- "joey" "/home/joey/lib/sound/podcasts"
+podcatcher :: Property DebianLike
+podcatcher = Cron.niceJob "podcatcher run hourly" (Cron.Times "55 * * * *")
+ (User "joey") "/home/joey/lib/sound/podcasts"
"xargs git-annex importfeed -c annex.genmetadata=true < feeds; mr --quiet update"
`requires` Apt.installed ["git-annex", "myrepos"]
-kiteMailServer :: Property
-kiteMailServer = propertyList "kitenet.net mail server"
- [ Postfix.installed
- , Apt.installed ["postfix-pcre"]
- , Apt.serviceInstalledRunning "postgrey"
+kiteMailServer :: Property (HasInfo + DebianLike)
+kiteMailServer = propertyList "kitenet.net mail server" $ props
+ & Postfix.installed
+ & Apt.installed ["postfix-pcre"]
+ & Apt.serviceInstalledRunning "postgrey"
- , Apt.serviceInstalledRunning "spamassassin"
- , "/etc/default/spamassassin" `File.containsLines`
+ & Apt.serviceInstalledRunning "spamassassin"
+ & "/etc/default/spamassassin" `File.containsLines`
[ "# Propellor deployed"
, "ENABLED=1"
- , "CRON=1"
, "OPTIONS=\"--create-prefs --max-children 5 --helper-home-dir\""
, "CRON=1"
, "NICE=\"--nicelevel 15\""
@@ -409,15 +512,15 @@ kiteMailServer = propertyList "kitenet.net mail server"
`describe` "spamd enabled"
`requires` Apt.serviceInstalledRunning "cron"
- , Apt.serviceInstalledRunning "spamass-milter"
+ & Apt.serviceInstalledRunning "spamass-milter"
-- Add -m to prevent modifying messages Subject or body.
- , "/etc/default/spamass-milter" `File.containsLine`
+ & "/etc/default/spamass-milter" `File.containsLine`
"OPTIONS=\"-m -u spamass-milter -i 127.0.0.1\""
`onChange` Service.restarted "spamass-milter"
`describe` "spamass-milter configured"
- , Apt.serviceInstalledRunning "amavisd-milter"
- , "/etc/default/amavisd-milter" `File.containsLines`
+ & Apt.serviceInstalledRunning "amavisd-milter"
+ & "/etc/default/amavisd-milter" `File.containsLines`
[ "# Propellor deployed"
, "MILTERSOCKET=/var/spool/postfix/amavis/amavis.sock"
, "MILTERSOCKETOWNER=\"postfix:postfix\""
@@ -425,10 +528,21 @@ kiteMailServer = propertyList "kitenet.net mail server"
]
`onChange` Service.restarted "amavisd-milter"
`describe` "amavisd-milter configured for postfix"
- , Apt.serviceInstalledRunning "clamav-freshclam"
+ & Apt.serviceInstalledRunning "clamav-freshclam"
+ -- Workaround https://bugs.debian.org/569150
+ & Cron.niceJob "amavis-expire" Cron.Daily (User "root") "/"
+ "find /var/lib/amavis/virusmails/ -type f -ctime +7 -delete"
+
+ & dkimInstalled
- , Apt.installed ["maildrop"]
- , "/etc/maildroprc" `File.hasContent`
+ & Postfix.saslAuthdInstalled
+ & Fail2Ban.installed
+ & Fail2Ban.jailEnabled "postfix-sasl"
+ & "/etc/default/saslauthd" `File.containsLine` "MECHANISMS=sasldb"
+ & Postfix.saslPasswdSet "kitenet.net" (User "errol")
+
+ & Apt.installed ["maildrop"]
+ & "/etc/maildroprc" `File.hasContent`
[ "# Global maildrop filter file (deployed with propellor)"
, "DEFAULT=\"$HOME/Maildir\""
, "MAILBOX=\"$DEFAULT/.\""
@@ -442,41 +556,40 @@ kiteMailServer = propertyList "kitenet.net mail server"
]
`describe` "maildrop configured"
- , "/etc/aliases" `File.hasPrivContentExposed` ctx
+ & "/etc/aliases" `File.hasPrivContentExposed` ctx
`onChange` Postfix.newaliases
- , hasJoeyCAChain
- , "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
- , "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
+ & hasJoeyCAChain
+ & hasPostfixCert ctx
- , "/etc/postfix/mydomain" `File.containsLines`
+ & "/etc/postfix/mydomain" `File.containsLines`
[ "/.*\\.kitenet\\.net/\tOK"
, "/ikiwiki\\.info/\tOK"
, "/joeyh\\.name/\tOK"
]
`onChange` Postfix.reloaded
`describe` "postfix mydomain file configured"
- , "/etc/postfix/obscure_client_relay.pcre" `File.hasContent`
+ & "/etc/postfix/obscure_client_relay.pcre" `File.hasContent`
-- Remove received lines for mails relayed from trusted
- -- clients. These can be a privacy vilation, or trigger
+ -- clients. These can be a privacy violation, or trigger
-- spam filters.
[ "/^Received: from ([^.]+)\\.kitenet\\.net.*using TLS.*by kitenet\\.net \\(([^)]+)\\) with (E?SMTPS?A?) id ([A-F[:digit:]]+)(.*)/ IGNORE"
-- Munge local Received line for postfix running on a
-- trusted client that relays through. These can trigger
-- spam filters.
- , "/^Received: by ([^.]+)\\.kitenet\\.net.*/ REPLACE Received: by kitenet.net"
+ , "/^Received: by ([^.]+)\\.kitenet\\.net.*/ REPLACE X-Question: 42"
]
`onChange` Postfix.reloaded
`describe` "postfix obscure_client_relay file configured"
- , Postfix.mappedFile "/etc/postfix/virtual"
+ & Postfix.mappedFile "/etc/postfix/virtual"
(flip File.containsLines
[ "# *@joeyh.name to joey"
, "@joeyh.name\tjoey"
]
) `describe` "postfix virtual file configured"
`onChange` Postfix.reloaded
- , Postfix.mappedFile "/etc/postfix/relay_clientcerts" $
- flip File.hasPrivContentExposed ctx
- , Postfix.mainCfFile `File.containsLines`
+ & Postfix.mappedFile "/etc/postfix/relay_clientcerts"
+ (flip File.hasPrivContentExposed ctx)
+ & Postfix.mainCfFile `File.containsLines`
[ "myhostname = kitenet.net"
, "mydomain = $myhostname"
, "append_dot_mydomain = no"
@@ -492,12 +605,21 @@ kiteMailServer = propertyList "kitenet.net mail server"
, "# Filter out client relay lines from headers."
, "header_checks = pcre:$config_directory/obscure_client_relay.pcre"
+ , "# Password auth for relaying (used by errol)"
+ , "smtpd_sasl_auth_enable = yes"
+ , "smtpd_sasl_security_options = noanonymous"
+ , "smtpd_sasl_local_domain = kitenet.net"
+
, "# Enable postgrey."
- , "smtpd_recipient_restrictions = permit_tls_clientcerts,permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023"
+ , "smtpd_recipient_restrictions = permit_tls_clientcerts,permit_sasl_authenticated,,permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023"
- , "# Enable spamass-milter and amavis-milter."
- , "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock"
+ , "# Enable spamass-milter, amavis-milter, opendkim"
+ , "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock inet:localhost:8891"
+ , "# opendkim is used for outgoing mail"
+ , "non_smtpd_milters = inet:localhost:8891"
, "milter_connect_macros = j {daemon_name} v {if_name} _"
+ , "# If a milter is broken, fall back to just accepting mail."
+ , "milter_default_action = accept"
, "# TLS setup -- server"
, "smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem"
@@ -521,24 +643,24 @@ kiteMailServer = propertyList "kitenet.net mail server"
`onChange` Postfix.reloaded
`describe` "postfix configured"
- , Apt.serviceInstalledRunning "dovecot-imapd"
- , Apt.serviceInstalledRunning "dovecot-pop3d"
- , "/etc/dovecot/conf.d/10-mail.conf" `File.containsLine`
+ & Apt.serviceInstalledRunning "dovecot-imapd"
+ & Apt.serviceInstalledRunning "dovecot-pop3d"
+ & "/etc/dovecot/conf.d/10-mail.conf" `File.containsLine`
"mail_location = maildir:~/Maildir"
`onChange` Service.reloaded "dovecot"
`describe` "dovecot mail.conf"
- , "/etc/dovecot/conf.d/10-auth.conf" `File.containsLine`
+ & "/etc/dovecot/conf.d/10-auth.conf" `File.containsLine`
"!include auth-passwdfile.conf.ext"
`onChange` Service.restarted "dovecot"
`describe` "dovecot auth.conf"
- , File.hasPrivContent dovecotusers ctx
+ & File.hasPrivContent dovecotusers ctx
`onChange` (dovecotusers `File.mode`
combineModes [ownerReadMode, groupReadMode])
- , File.ownerGroup dovecotusers "root" "dovecot"
+ & File.ownerGroup dovecotusers (User "root") (Group "dovecot")
- , Apt.installed ["mutt", "bsd-mailx", "alpine"]
+ & Apt.installed ["mutt", "bsd-mailx", "alpine"]
- , pinescript `File.hasContent`
+ & pinescript `File.hasContent`
[ "#!/bin/sh"
, "# deployed with propellor"
, "set -e"
@@ -552,44 +674,98 @@ kiteMailServer = propertyList "kitenet.net mail server"
`onChange` (pinescript `File.mode`
combineModes (readModes ++ executeModes))
`describe` "pine wrapper script"
- , "/etc/pine.conf" `File.hasContent`
+ & "/etc/pine.conf" `File.hasContent`
[ "# deployed with propellor"
, "inbox-path={localhost/novalidate-cert/NoRsh}inbox"
]
`describe` "pine configured to use local imap server"
- , Apt.serviceInstalledRunning "mailman"
- ]
+ & Apt.serviceInstalledRunning "mailman"
+
+ & Postfix.service ssmtp
where
ctx = Context "kitenet.net"
pinescript = "/usr/local/bin/pine"
dovecotusers = "/etc/dovecot/users"
-hasJoeyCAChain :: Property
+ ssmtp = Postfix.Service
+ (Postfix.InetService Nothing "ssmtp")
+ "smtpd" Postfix.defServiceOpts
+
+-- Configures postfix to relay outgoing mail to kitenet.net, with
+-- verification via tls cert.
+postfixClientRelay :: Context -> Property (HasInfo + DebianLike)
+postfixClientRelay ctx = Postfix.mainCfFile `File.containsLines`
+ -- Using smtps not smtp because more networks firewall smtp
+ [ "relayhost = kitenet.net:smtps"
+ , "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem"
+ , "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem"
+ , "smtp_tls_key_file = /etc/ssl/private/postfix.pem"
+ , "smtp_tls_loglevel = 0"
+ , "smtp_use_tls = yes"
+ ]
+ `describe` "postfix client relay"
+ `onChange` Postfix.dedupMainCf
+ `onChange` Postfix.reloaded
+ `requires` hasJoeyCAChain
+ `requires` hasPostfixCert ctx
+
+-- Configures postfix to have the dkim milter, and no other milters.
+dkimMilter :: Property (HasInfo + DebianLike)
+dkimMilter = Postfix.mainCfFile `File.containsLines`
+ [ "smtpd_milters = inet:localhost:8891"
+ , "non_smtpd_milters = inet:localhost:8891"
+ , "milter_default_action = accept"
+ ]
+ `describe` "postfix dkim milter"
+ `onChange` Postfix.dedupMainCf
+ `onChange` Postfix.reloaded
+ `requires` dkimInstalled
+
+-- This does not configure postfix to use the dkim milter,
+-- nor does it set up domainkey DNS.
+dkimInstalled :: Property (HasInfo + DebianLike)
+dkimInstalled = go `onChange` Service.restarted "opendkim"
+ where
+ go = propertyList "opendkim installed" $ props
+ & Apt.serviceInstalledRunning "opendkim"
+ & File.dirExists "/etc/mail"
+ & File.hasPrivContent "/etc/mail/dkim.key" (Context "kitenet.net")
+ & File.ownerGroup "/etc/mail/dkim.key" (User "opendkim") (Group "opendkim")
+ & "/etc/default/opendkim" `File.containsLine`
+ "SOCKET=\"inet:8891@localhost\""
+ & "/etc/opendkim.conf" `File.containsLines`
+ [ "KeyFile /etc/mail/dkim.key"
+ , "SubDomains yes"
+ , "Domain *"
+ , "Selector mail"
+ ]
+
+-- This is the dkim public key, corresponding with /etc/mail/dkim.key
+-- This value can be included in a domain's additional records to make
+-- it use this domainkey.
+domainKey :: (BindDomain, Record)
+domainKey = (RelDomain "mail._domainkey", TXT "v=DKIM1; k=rsa; p=MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQCc+/rfzNdt5DseBBmfB3C6sVM7FgVvf4h1FeCfyfwPpVcmPdW6M2I+NtJsbRkNbEICxiP6QY2UM0uoo9TmPqLgiCCG2vtuiG6XMsS0Y/gGwqKM7ntg/7vT1Go9vcquOFFuLa5PnzpVf8hB9+PMFdS4NPTvWL2c5xxshl/RJzICnQIDAQAB")
+
+hasJoeyCAChain :: Property (HasInfo + UnixLike)
hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed`
Context "joeyca.pem"
-kitenetHttps :: Property
-kitenetHttps = propertyList "kitenet.net https certs"
- [ File.hasPrivContent "/etc/ssl/certs/web.pem" ctx
- , File.hasPrivContent "/etc/ssl/private/web.pem" ctx
- , File.hasPrivContent "/etc/ssl/certs/startssl.pem" ctx
- , toProp $ Apache.modEnabled "ssl"
- ]
- where
- ctx = Context "kitenet.net"
+hasPostfixCert :: Context -> Property (HasInfo + UnixLike)
+hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props
+ & "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
+ & "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
-- Legacy static web sites and redirections from kitenet.net to newer
-- sites.
-legacyWebSites :: Property
-legacyWebSites = propertyList "legacy web sites"
- [ Apt.serviceInstalledRunning "apache2"
- , toProp $ Apache.modEnabled "rewrite"
- , toProp $ Apache.modEnabled "cgi"
- , toProp $ Apache.modEnabled "speling"
- , userDirHtml
- , kitenetHttps
- , toProp $ Apache.siteEnabled "kitenet.net" $ apachecfg "kitenet.net" True
+legacyWebSites :: Property (HasInfo + DebianLike)
+legacyWebSites = propertyList "legacy web sites" $ props
+ & Apt.serviceInstalledRunning "apache2"
+ & Apache.modEnabled "rewrite"
+ & Apache.modEnabled "cgi"
+ & Apache.modEnabled "speling"
+ & userDirHtml
+ & Apache.httpsVirtualHost' "kitenet.net" "/var/www" letos
-- /var/www is empty
[ "DocumentRoot /var/www"
, "<Directory /var/www>"
@@ -676,8 +852,8 @@ legacyWebSites = propertyList "legacy web sites"
, "rewriterule /~kyle/family/wiki/(.*).rss http://macleawiki.branchable.com/$1/index.rss [L]"
, "rewriterule /~kyle/family/wiki(.*) http://macleawiki.branchable.com$1 [L]"
]
- , alias "anna.kitenet.net"
- , toProp $ Apache.siteEnabled "anna.kitenet.net" $ apachecfg "anna.kitenet.net" False
+ & alias "anna.kitenet.net"
+ & apacheSite "anna.kitenet.net"
[ "DocumentRoot /home/anna/html"
, "<Directory /home/anna/html/>"
, " Options Indexes ExecCGI"
@@ -685,9 +861,9 @@ legacyWebSites = propertyList "legacy web sites"
, Apache.allowAll
, "</Directory>"
]
- , alias "sows-ear.kitenet.net"
- , alias "www.sows-ear.kitenet.net"
- , toProp $ Apache.siteEnabled "sows-ear.kitenet.net" $ apachecfg "sows-ear.kitenet.net" False
+ & alias "sows-ear.kitenet.net"
+ & alias "www.sows-ear.kitenet.net"
+ & apacheSite "sows-ear.kitenet.net"
[ "ServerAlias www.sows-ear.kitenet.net"
, "DocumentRoot /srv/web/sows-ear.kitenet.net"
, "<Directory /srv/web/sows-ear.kitenet.net>"
@@ -695,10 +871,12 @@ legacyWebSites = propertyList "legacy web sites"
, " AllowOverride None"
, Apache.allowAll
, "</Directory>"
+ , "RewriteEngine On"
+ , "RewriteRule .* http://www.sowsearpoetry.org/ [L]"
]
- , alias "wortroot.kitenet.net"
- , alias "www.wortroot.kitenet.net"
- , toProp $ Apache.siteEnabled "wortroot.kitenet.net" $ apachecfg "wortroot.kitenet.net" False
+ & alias "wortroot.kitenet.net"
+ & alias "www.wortroot.kitenet.net"
+ & apacheSite "wortroot.kitenet.net"
[ "ServerAlias www.wortroot.kitenet.net"
, "DocumentRoot /srv/web/wortroot.kitenet.net"
, "<Directory /srv/web/wortroot.kitenet.net>"
@@ -707,8 +885,8 @@ legacyWebSites = propertyList "legacy web sites"
, Apache.allowAll
, "</Directory>"
]
- , alias "creeksidepress.com"
- , toProp $ Apache.siteEnabled "creeksidepress.com" $ apachecfg "creeksidepress.com" False
+ & alias "creeksidepress.com"
+ & apacheSite "creeksidepress.com"
[ "ServerAlias www.creeksidepress.com"
, "DocumentRoot /srv/web/www.creeksidepress.com"
, "<Directory /srv/web/www.creeksidepress.com>"
@@ -717,8 +895,8 @@ legacyWebSites = propertyList "legacy web sites"
, Apache.allowAll
, "</Directory>"
]
- , alias "joey.kitenet.net"
- , toProp $ Apache.siteEnabled "joey.kitenet.net" $ apachecfg "joey.kitenet.net" False
+ & alias "joey.kitenet.net"
+ & apacheSite "joey.kitenet.net"
[ "DocumentRoot /var/www"
, "<Directory /var/www/>"
, " Options Indexes ExecCGI"
@@ -738,12 +916,50 @@ legacyWebSites = propertyList "legacy web sites"
, "# Redirect all to joeyh.name."
, "rewriterule (.*) http://joeyh.name$1 [r]"
]
- ]
-userDirHtml :: Property
+userDirHtml :: Property DebianLike
userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
`onChange` Apache.reloaded
- `requires` (toProp $ Apache.modEnabled "userdir")
+ `requires` Apache.modEnabled "userdir"
where
munge = replace "public_html" "html"
conf = "/etc/apache2/mods-available/userdir.conf"
+
+-- Alarm clock: see
+-- <http://joeyh.name/blog/entry/a_programmable_alarm_clock_using_systemd/>
+--
+-- oncalendar example value: "*-*-* 7:30"
+alarmClock :: String -> User -> String -> Property DebianLike
+alarmClock oncalendar (User user) command = combineProperties "goodmorning timer installed" $ props
+ & "/etc/systemd/system/goodmorning.timer" `File.hasContent`
+ [ "[Unit]"
+ , "Description=good morning"
+ , ""
+ , "[Timer]"
+ , "Unit=goodmorning.service"
+ , "OnCalendar=" ++ oncalendar
+ , "WakeSystem=true"
+ , "Persistent=false"
+ , ""
+ , "[Install]"
+ , "WantedBy=multi-user.target"
+ ]
+ `onChange` (Systemd.daemonReloaded
+ `before` Systemd.restarted "goodmorning.timer")
+ & "/etc/systemd/system/goodmorning.service" `File.hasContent`
+ [ "[Unit]"
+ , "Description=good morning"
+ , "RefuseManualStart=true"
+ , "RefuseManualStop=true"
+ , "ConditionACPower=true"
+ , "StopWhenUnneeded=yes"
+ , ""
+ , "[Service]"
+ , "Type=oneshot"
+ , "ExecStart=/bin/systemd-inhibit --what=handle-lid-switch --why=goodmorning /bin/su " ++ user ++ " -c \"" ++ command ++ "\""
+ ]
+ `onChange` Systemd.daemonReloaded
+ & Systemd.enabled "goodmorning.timer"
+ & Systemd.started "goodmorning.timer"
+ & "/etc/systemd/logind.conf" `ConfFile.containsIniSetting`
+ ("Login", "LidSwitchIgnoreInhibited", "no")
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 4ecdf23e..6e1690d2 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -1,26 +1,60 @@
+{-# LANGUAGE DeriveDataTypeable, TypeFamilies #-}
+
module Propellor.Property.Ssh (
+ installed,
+ restarted,
+ PubKeyText,
+ SshKeyType(..),
+ -- * Daemon configuration
+ sshdConfig,
+ ConfigKeyword,
+ setSshdConfigBool,
setSshdConfig,
+ RootLogin(..),
permitRootLogin,
passwordAuthentication,
- hasAuthorizedKeys,
- restarted,
+ noPasswords,
+ listenPort,
+ -- * Host keys
randomHostKeys,
hostKeys,
hostKey,
- keyImported,
+ hostPubKey,
+ getHostPubKey,
+ -- * User keys and configuration
+ userKeys,
+ userKeyAt,
knownHost,
+ unknownHost,
+ authorizedKeysFrom,
+ unauthorizedKeysFrom,
authorizedKeys,
- listenPort
+ authorizedKey,
+ hasAuthorizedKeys,
+ getUserPubKeys,
) where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.Apt as Apt
import Propellor.Property.User
-import Utility.SafeCommand
+import Propellor.Types.Info
import Utility.FileMode
import System.PosixCompat
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.List
+
+installed :: Property UnixLike
+installed = "ssh installed" ==> (aptinstall `pickOS` unsupportedOS)
+ where
+ aptinstall :: Property DebianLike
+ aptinstall = Apt.installed ["ssh"]
+
+restarted :: Property DebianLike
+restarted = Service.restarted "ssh"
sshBool :: Bool -> String
sshBool True = "yes"
@@ -29,107 +63,251 @@ sshBool False = "no"
sshdConfig :: FilePath
sshdConfig = "/etc/ssh/sshd_config"
-setSshdConfig :: String -> Bool -> Property
-setSshdConfig setting allowed = combineProperties "sshd config"
- [ sshdConfig `File.lacksLine` (sshline $ not allowed)
- , sshdConfig `File.containsLine` (sshline allowed)
- ]
+type ConfigKeyword = String
+
+setSshdConfigBool :: ConfigKeyword -> Bool -> Property DebianLike
+setSshdConfigBool setting allowed = setSshdConfig setting (sshBool allowed)
+
+setSshdConfig :: ConfigKeyword -> String -> Property DebianLike
+setSshdConfig setting val = File.fileProperty desc f sshdConfig
`onChange` restarted
- `describe` unwords [ "ssh config:", setting, sshBool allowed ]
where
- sshline v = setting ++ " " ++ sshBool v
+ desc = unwords [ "ssh config:", setting, val ]
+ cfgline = setting ++ " " ++ val
+ wantedline s
+ | s == cfgline = True
+ | (setting ++ " ") `isPrefixOf` s = False
+ | otherwise = True
+ f ls
+ | cfgline `elem` ls = filter wantedline ls
+ | otherwise = filter wantedline ls ++ [cfgline]
+
+data RootLogin
+ = RootLogin Bool -- ^ allow or prevent root login
+ | WithoutPassword -- ^ disable password authentication for root, while allowing other authentication methods
+ | ForcedCommandsOnly -- ^ allow root login with public-key authentication, but only if a forced command has been specified for the public key
-permitRootLogin :: Bool -> Property
-permitRootLogin = setSshdConfig "PermitRootLogin"
+permitRootLogin :: RootLogin -> Property DebianLike
+permitRootLogin (RootLogin b) = setSshdConfigBool "PermitRootLogin" b
+permitRootLogin WithoutPassword = setSshdConfig "PermitRootLogin" "without-password"
+permitRootLogin ForcedCommandsOnly = setSshdConfig "PermitRootLogin" "forced-commands-only"
-passwordAuthentication :: Bool -> Property
-passwordAuthentication = setSshdConfig "PasswordAuthentication"
+passwordAuthentication :: Bool -> Property DebianLike
+passwordAuthentication = setSshdConfigBool "PasswordAuthentication"
-dotDir :: UserName -> IO FilePath
+-- | Configure ssh to not allow password logins.
+--
+-- To prevent lock-out, this is done only once root's
+-- authorized_keys is in place.
+noPasswords :: Property DebianLike
+noPasswords = check (hasAuthorizedKeys (User "root")) $
+ passwordAuthentication False
+
+dotDir :: User -> IO FilePath
dotDir user = do
h <- homedir user
return $ h </> ".ssh"
-dotFile :: FilePath -> UserName -> IO FilePath
+dotFile :: FilePath -> User -> IO FilePath
dotFile f user = do
d <- dotDir user
return $ d </> f
-hasAuthorizedKeys :: UserName -> IO Bool
+-- | Makes the ssh server listen on a given port, in addition to any other
+-- ports it is configured to listen on.
+--
+-- Revert to prevent it listening on a particular port.
+listenPort :: Port -> RevertableProperty DebianLike DebianLike
+listenPort port = enable <!> disable
+ where
+ portline = "Port " ++ fromPort port
+ enable = sshdConfig `File.containsLine` portline
+ `describe` ("ssh listening on " ++ portline)
+ `onChange` restarted
+ disable = sshdConfig `File.lacksLine` portline
+ `describe` ("ssh not listening on " ++ portline)
+ `onChange` restarted
+
+hasAuthorizedKeys :: User -> IO Bool
hasAuthorizedKeys = go <=< dotFile "authorized_keys"
where
go f = not . null <$> catchDefaultIO "" (readFile f)
-restarted :: Property
-restarted = Service.restarted "ssh"
-
-- | Blows away existing host keys and make new ones.
-- Useful for systems installed from an image that might reuse host keys.
-- A flag file is used to only ever do this once.
-randomHostKeys :: Property
+randomHostKeys :: Property DebianLike
randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
`onChange` restarted
where
- prop = property "ssh random host keys" $ do
+ prop :: Property UnixLike
+ prop = property' "ssh random host keys" $ \w -> do
void $ liftIO $ boolSystem "sh"
[ Param "-c"
, Param "rm -f /etc/ssh/ssh_host_*"
]
- ensureProperty $ scriptProperty
- [ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
-
--- | Sets all types of ssh host keys from the privdata.
-hostKeys :: Context -> Property
-hostKeys ctx = propertyList "known ssh host keys"
- [ hostKey SshDsa ctx
- , hostKey SshRsa ctx
- , hostKey SshEcdsa ctx
- ]
-
--- | Sets a single ssh host key from the privdata.
-hostKey :: SshKeyType -> Context -> Property
-hostKey keytype context = combineProperties desc
- [ installkey (SshPubKey keytype "") (install writeFile ".pub")
- , installkey (SshPrivKey keytype "") (install writeFileProtected "")
- ]
- `onChange` restarted
+ ensureProperty w $ scriptProperty [ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
+ `assume` MadeChange
+
+-- | The text of a ssh public key, for example, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI"
+type PubKeyText = String
+
+-- | Installs the specified list of ssh host keys.
+--
+-- The corresponding private keys come from the privdata.
+--
+-- Any host keys that are not in the list are removed from the host.
+hostKeys :: IsContext c => c -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + DebianLike)
+hostKeys ctx l = go `before` cleanup
+ where
+ desc = "ssh host keys configured " ++ typelist (map fst l)
+ go :: Property (HasInfo + DebianLike)
+ go = propertyList desc $ toProps $ catMaybes $
+ map (\(t, pub) -> Just $ hostKey ctx t pub) l
+ typelist tl = "(" ++ unwords (map fromKeyType tl) ++ ")"
+ alltypes = [minBound..maxBound]
+ staletypes = let have = map fst l in filter (`notElem` have) alltypes
+ removestale :: Bool -> [Property DebianLike]
+ removestale b = map (tightenTargets . File.notPresent . flip keyFile b) staletypes
+ cleanup :: Property DebianLike
+ cleanup
+ | null staletypes || null l = doNothing
+ | otherwise =
+ combineProperties ("any other ssh host keys removed " ++ typelist staletypes)
+ (toProps $ removestale True ++ removestale False)
+ `onChange` restarted
+
+-- | Installs a single ssh host key of a particular type.
+--
+-- The public key is provided to this function;
+-- the private key comes from the privdata;
+hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property (HasInfo + DebianLike)
+hostKey context keytype pub = go `onChange` restarted
where
- desc = "known ssh host key (" ++ fromKeyType keytype ++ ")"
- installkey p a = withPrivData p context $ \getkey ->
- property desc $ getkey a
- install writer ext key = do
- let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
- s <- liftIO $ readFileStrict f
- if s == key
- then noChange
- else makeChange $ writer f key
-
--- | Sets up a user with a ssh private key and public key pair from the
--- PrivData.
-keyImported :: SshKeyType -> UserName -> Context -> Property
-keyImported keytype user context = combineProperties desc
- [ installkey (SshPubKey keytype user) (install writeFile ".pub")
- , installkey (SshPrivKey keytype user) (install writeFileProtected "")
- ]
- where
- desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"
- installkey p a = withPrivData p context $ \getkey ->
- property desc $ getkey a
- install writer ext key = do
+ go = combineProperties desc $ props
+ & hostPubKey keytype pub
+ & installpub
+ & installpriv
+ desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")"
+ keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext)
+ ("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey")
+ installpub :: Property UnixLike
+ installpub = keywriter File.hasContent True (lines pub)
+ installpriv :: Property (HasInfo + UnixLike)
+ installpriv = withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey ->
+ property' desc $ \w -> getkey $
+ ensureProperty w
+ . keywriter File.hasContentProtected False
+ . privDataLines
+ keywriter p ispub keylines = do
+ let f = keyFile keytype ispub
+ p f (keyFileContent keylines)
+
+-- Make sure that there is a newline at the end;
+-- ssh requires this for some types of private keys.
+keyFileContent :: [String] -> [File.Line]
+keyFileContent keylines = keylines ++ [""]
+
+keyFile :: SshKeyType -> Bool -> FilePath
+keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
+ where
+ ext = if ispub then ".pub" else ""
+
+-- | Indicates the host key that is used by a Host, but does not actually
+-- configure the host to use it. Normally this does not need to be used;
+-- use 'hostKey' instead.
+hostPubKey :: SshKeyType -> PubKeyText -> Property (HasInfo + UnixLike)
+hostPubKey t = pureInfoProperty "ssh pubkey known" . HostKeyInfo . M.singleton t
+
+getHostPubKey :: Propellor (M.Map SshKeyType PubKeyText)
+getHostPubKey = fromHostKeyInfo <$> askInfo
+
+newtype HostKeyInfo = HostKeyInfo
+ { fromHostKeyInfo :: M.Map SshKeyType PubKeyText }
+ deriving (Eq, Ord, Typeable, Show)
+
+instance IsInfo HostKeyInfo where
+ propagateInfo _ = False
+
+instance Monoid HostKeyInfo where
+ mempty = HostKeyInfo M.empty
+ mappend (HostKeyInfo old) (HostKeyInfo new) =
+ -- new first because union prefers values from the first
+ -- parameter when there is a duplicate key
+ HostKeyInfo (new `M.union` old)
+
+userPubKeys :: User -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + UnixLike)
+userPubKeys u@(User n) l = pureInfoProperty ("ssh pubkey for " ++ n) $
+ UserKeyInfo (M.singleton u (S.fromList l))
+
+getUserPubKeys :: User -> Propellor [(SshKeyType, PubKeyText)]
+getUserPubKeys u = maybe [] S.toList . M.lookup u . fromUserKeyInfo <$> askInfo
+
+newtype UserKeyInfo = UserKeyInfo
+ { fromUserKeyInfo :: M.Map User (S.Set (SshKeyType, PubKeyText)) }
+ deriving (Eq, Ord, Typeable, Show)
+
+instance IsInfo UserKeyInfo where
+ propagateInfo _ = False
+
+instance Monoid UserKeyInfo where
+ mempty = UserKeyInfo M.empty
+ mappend (UserKeyInfo old) (UserKeyInfo new) =
+ UserKeyInfo (M.unionWith S.union old new)
+
+-- | Sets up a user with the specified public keys, and the corresponding
+-- private keys from the privdata.
+--
+-- The public keys are added to the Info, so other properties like
+-- `authorizedKeysFrom` can use them.
+userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + UnixLike)
+userKeys user@(User name) context ks = combineProperties desc $ toProps $
+ userPubKeys user ks : map (userKeyAt Nothing user context) ks
+ where
+ desc = unwords
+ [ name
+ , "has ssh key"
+ , "(" ++ unwords (map (fromKeyType . fst) ks) ++ ")"
+ ]
+
+-- | Sets up a user with the specified pubic key, and a private
+-- key from the privdata.
+--
+-- A file can be specified to write the key to somewhere other than
+-- the default locations. Allows a user to have multiple keys for
+-- different roles.
+userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property (HasInfo + UnixLike)
+userKeyAt dest user@(User u) context (keytype, pubkeytext) =
+ combineProperties desc $ props
+ & pubkey
+ & privkey
+ where
+ desc = unwords $ catMaybes
+ [ Just u
+ , Just "has ssh key"
+ , dest
+ , Just $ "(" ++ fromKeyType keytype ++ ")"
+ ]
+ pubkey :: Property UnixLike
+ pubkey = property' desc $ \w ->
+ ensureProperty w =<< installprop File.hasContent ".pub" [pubkeytext]
+ privkey :: Property (HasInfo + UnixLike)
+ privkey = withPrivData (SshPrivKey keytype u) context privkey'
+ privkey' :: ((PrivData -> Propellor Result) -> Propellor Result) -> Property (HasInfo + UnixLike)
+ privkey' getkey = property' desc $ \w -> getkey $ \k ->
+ ensureProperty w
+ =<< installprop File.hasContentProtected "" (privDataLines k)
+ installprop writer ext key = do
f <- liftIO $ keyfile ext
- ifM (liftIO $ doesFileExist f)
- ( noChange
- , ensureProperties
- [ property desc $ makeChange $ do
- createDirectoryIfMissing True (takeDirectory f)
- writer f key
- , File.ownerGroup f user user
- , File.ownerGroup (takeDirectory f) user user
- ]
- )
- keyfile ext = do
- home <- homeDirectory <$> getUserEntryForName user
- return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
+ return $ combineProperties desc $ props
+ & writer f (keyFileContent key)
+ & File.ownerGroup f user (userGroup user)
+ & File.ownerGroup (takeDirectory f) user (userGroup user)
+ keyfile ext = case dest of
+ Nothing -> do
+ home <- homeDirectory <$> getUserEntryForName u
+ return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
+ Just f -> return $ f ++ ext
fromKeyType :: SshKeyType -> String
fromKeyType SshRsa = "rsa"
@@ -137,47 +315,119 @@ fromKeyType SshDsa = "dsa"
fromKeyType SshEcdsa = "ecdsa"
fromKeyType SshEd25519 = "ed25519"
--- | Puts some host's ssh public key into the known_hosts file for a user.
-knownHost :: [Host] -> HostName -> UserName -> Property
-knownHost hosts hn user = property desc $
- go =<< fromHost hosts hn getSshPubKey
+-- | Puts some host's ssh public key(s), as set using `hostPubKey`
+-- or `hostKey` into the known_hosts file for a user.
+knownHost :: [Host] -> HostName -> User -> Property UnixLike
+knownHost hosts hn user@(User u) = property' desc $ \w ->
+ go w =<< knownHostLines hosts hn
where
- desc = user ++ " knows ssh key for " ++ hn
- go (Just (Just k)) = do
+ desc = u ++ " knows ssh key for " ++ hn
+
+ go _ [] = do
+ warningMessage $ "no configured ssh host keys for " ++ hn
+ return FailedChange
+ go w ls = do
f <- liftIO $ dotFile "known_hosts" user
- ensureProperty $ combineProperties desc
- [ File.dirExists (takeDirectory f)
- , f `File.containsLine` (hn ++ " " ++ k)
- , File.ownerGroup f user user
- ]
- go _ = do
- warningMessage $ "no configred sshPubKey for " ++ hn
+ ensureProperty w $ modKnownHost user f $
+ f `File.containsLines` ls
+ `requires` File.dirExists (takeDirectory f)
+
+-- | Reverts `knownHost`
+unknownHost :: [Host] -> HostName -> User -> Property UnixLike
+unknownHost hosts hn user@(User u) = property' desc $ \w ->
+ go w =<< knownHostLines hosts hn
+ where
+ desc = u ++ " does not know ssh key for " ++ hn
+
+ go _ [] = return NoChange
+ go w ls = do
+ f <- liftIO $ dotFile "known_hosts" user
+ ifM (liftIO $ doesFileExist f)
+ ( ensureProperty w $ modKnownHost user f $
+ f `File.lacksLines` ls
+ , return NoChange
+ )
+
+knownHostLines :: [Host] -> HostName -> Propellor [File.Line]
+knownHostLines hosts hn = keylines <$> fromHost hosts hn getHostPubKey
+ where
+ keylines (Just m) = map (\k -> hn ++ " " ++ k) (M.elems m)
+ keylines Nothing = []
+
+modKnownHost :: User -> FilePath -> Property UnixLike -> Property UnixLike
+modKnownHost user f p = p
+ `requires` File.ownerGroup f user (userGroup user)
+ `requires` File.ownerGroup (takeDirectory f) user (userGroup user)
+
+-- | Ensures that a local user's authorized_keys contains lines allowing
+-- logins from a remote user on the specified Host.
+--
+-- The ssh keys of the remote user can be set using `keysImported`
+--
+-- Any other lines in the authorized_keys file are preserved as-is.
+authorizedKeysFrom :: User -> (User, Host) -> Property UnixLike
+localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) =
+ property' desc (\w -> go w =<< authorizedKeyLines remoteuser remotehost)
+ where
+ remote = rn ++ "@" ++ hostName remotehost
+ desc = ln ++ " authorized_keys from " ++ remote
+
+ go _ [] = do
+ warningMessage $ "no configured ssh user keys for " ++ remote
return FailedChange
+ go w ls = ensureProperty w $ combineProperties desc $ toProps $
+ map (setupRevertableProperty . authorizedKey localuser) ls
+
+-- | Reverts `authorizedKeysFrom`
+unauthorizedKeysFrom :: User -> (User, Host) -> Property UnixLike
+localuser@(User ln) `unauthorizedKeysFrom` (remoteuser@(User rn), remotehost) =
+ property' desc (\w -> go w =<< authorizedKeyLines remoteuser remotehost)
+ where
+ remote = rn ++ "@" ++ hostName remotehost
+ desc = ln ++ " unauthorized_keys from " ++ remote
+
+ go _ [] = return NoChange
+ go w ls = ensureProperty w $ combineProperties desc $ toProps $
+ map (undoRevertableProperty . authorizedKey localuser) ls
+
+authorizedKeyLines :: User -> Host -> Propellor [File.Line]
+authorizedKeyLines remoteuser remotehost =
+ map snd <$> fromHost' remotehost (getUserPubKeys remoteuser)
-- | Makes a user have authorized_keys from the PrivData
-authorizedKeys :: UserName -> Context -> Property
-authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get ->
- property (user ++ " has authorized_keys") $ get $ \v -> do
+--
+-- This removes any other lines from the file.
+authorizedKeys :: IsContext c => User -> c -> Property (HasInfo + UnixLike)
+authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) context $ \get ->
+ property' desc $ \w -> get $ \v -> do
f <- liftIO $ dotFile "authorized_keys" user
- liftIO $ do
- createDirectoryIfMissing True (takeDirectory f)
- writeFileProtected f v
- ensureProperties
- [ File.ownerGroup f user user
- , File.ownerGroup (takeDirectory f) user user
- ]
+ ensureProperty w $ combineProperties desc $ props
+ & File.hasContentProtected f (keyFileContent (privDataLines v))
+ & File.ownerGroup f user (userGroup user)
+ & File.ownerGroup (takeDirectory f) user (userGroup user)
+ where
+ desc = u ++ " has authorized_keys"
--- | Makes the ssh server listen on a given port, in addition to any other
--- ports it is configured to listen on.
---
--- Revert to prevent it listening on a particular port.
-listenPort :: Int -> RevertableProperty
-listenPort port = RevertableProperty enable disable
+-- | Ensures that a user's authorized_keys contains a line.
+-- Any other lines in the file are preserved as-is.
+authorizedKey :: User -> String -> RevertableProperty UnixLike UnixLike
+authorizedKey user@(User u) l = add <!> remove
where
- portline = "Port " ++ show port
- enable = sshdConfig `File.containsLine` portline
- `describe` ("ssh listening on " ++ portline)
- `onChange` restarted
- disable = sshdConfig `File.lacksLine` portline
- `describe` ("ssh not listening on " ++ portline)
- `onChange` restarted
+ add = property' (u ++ " has authorized_keys") $ \w -> do
+ f <- liftIO $ dotFile "authorized_keys" user
+ ensureProperty w $ modAuthorizedKey f user $
+ f `File.containsLine` l
+ `requires` File.dirExists (takeDirectory f)
+ remove = property' (u ++ " lacks authorized_keys") $ \w -> do
+ f <- liftIO $ dotFile "authorized_keys" user
+ ifM (liftIO $ doesFileExist f)
+ ( ensureProperty w $ modAuthorizedKey f user $
+ f `File.lacksLine` l
+ , return NoChange
+ )
+
+modAuthorizedKey :: FilePath -> User -> Property UnixLike -> Property UnixLike
+modAuthorizedKey f user p = p
+ `before` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
+ `before` File.ownerGroup f user (userGroup user)
+ `before` File.ownerGroup (takeDirectory f) user (userGroup user)
diff --git a/src/Propellor/Property/Sudo.hs b/src/Propellor/Property/Sudo.hs
index 3651891d..45ab8af2 100644
--- a/src/Propellor/Property/Sudo.hs
+++ b/src/Propellor/Property/Sudo.hs
@@ -2,24 +2,25 @@ module Propellor.Property.Sudo where
import Data.List
-import Propellor
+import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.User
-- | Allows a user to sudo. If the user has a password, sudo is configured
-- to require it. If not, NOPASSWORD is enabled for the user.
-enabledFor :: UserName -> Property
-enabledFor user = property desc go `requires` Apt.installed ["sudo"]
+enabledFor :: User -> Property DebianLike
+enabledFor user@(User u) = go `requires` Apt.installed ["sudo"]
where
- go = do
+ go :: Property UnixLike
+ go = property' desc $ \w -> do
locked <- liftIO $ isLockedPassword user
- ensureProperty $
+ ensureProperty w $
fileProperty desc
(modify locked . filter (wanted locked))
"/etc/sudoers"
- desc = user ++ " is sudoer"
- sudobaseline = user ++ " ALL=(ALL:ALL)"
+ desc = u ++ " is sudoer"
+ sudobaseline = u ++ " ALL=(ALL:ALL)"
sudoline True = sudobaseline ++ " NOPASSWD:ALL"
sudoline False = sudobaseline ++ " ALL"
wanted locked l
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
new file mode 100644
index 00000000..e11c991e
--- /dev/null
+++ b/src/Propellor/Property/Systemd.hs
@@ -0,0 +1,473 @@
+{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
+
+module Propellor.Property.Systemd (
+ -- * Services
+ ServiceName,
+ started,
+ stopped,
+ enabled,
+ disabled,
+ masked,
+ running,
+ restarted,
+ networkd,
+ journald,
+ logind,
+ -- * Configuration
+ installed,
+ Option,
+ configured,
+ daemonReloaded,
+ -- * Journal
+ persistentJournal,
+ journaldConfigured,
+ -- * Logind
+ logindConfigured,
+ killUserProcesses,
+ -- * Containers and machined
+ machined,
+ MachineName,
+ Container,
+ container,
+ debContainer,
+ nspawned,
+ -- * Container configuration
+ containerCfg,
+ resolvConfed,
+ linkJournal,
+ privateNetwork,
+ module Propellor.Types.Container,
+ Proto(..),
+ Publishable,
+ publish,
+ Bindable,
+ bind,
+ bindRo,
+) where
+
+import Propellor.Base
+import Propellor.Types.Chroot
+import Propellor.Types.Container
+import Propellor.Container
+import Propellor.Types.Info
+import qualified Propellor.Property.Chroot as Chroot
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+import Propellor.Property.Systemd.Core
+import Utility.FileMode
+
+import Data.List
+import Data.List.Utils
+import qualified Data.Map as M
+
+type ServiceName = String
+
+type MachineName = String
+
+data Container = Container MachineName Chroot.Chroot Host
+ deriving (Show)
+
+instance IsContainer Container where
+ containerProperties (Container _ _ h) = containerProperties h
+ containerInfo (Container _ _ h) = containerInfo h
+ setContainerProperties (Container n c h) ps = Container n c (setContainerProperties h ps)
+
+-- | Starts a systemd service.
+--
+-- Note that this does not configure systemd to start the service on boot,
+-- it only ensures that the service is currently running.
+started :: ServiceName -> Property Linux
+started n = tightenTargets $ cmdProperty "systemctl" ["start", n]
+ `assume` NoChange
+ `describe` ("service " ++ n ++ " started")
+
+-- | Stops a systemd service.
+stopped :: ServiceName -> Property Linux
+stopped n = tightenTargets $ cmdProperty "systemctl" ["stop", n]
+ `assume` NoChange
+ `describe` ("service " ++ n ++ " stopped")
+
+-- | Enables a systemd service.
+--
+-- This does not ensure the service is started, it only configures systemd
+-- to start it on boot.
+enabled :: ServiceName -> Property Linux
+enabled n = tightenTargets $ cmdProperty "systemctl" ["enable", n]
+ `assume` NoChange
+ `describe` ("service " ++ n ++ " enabled")
+
+-- | Disables a systemd service.
+disabled :: ServiceName -> Property Linux
+disabled n = tightenTargets $ cmdProperty "systemctl" ["disable", n]
+ `assume` NoChange
+ `describe` ("service " ++ n ++ " disabled")
+
+-- | Masks a systemd service.
+masked :: ServiceName -> RevertableProperty Linux Linux
+masked n = systemdMask <!> systemdUnmask
+ where
+ systemdMask = tightenTargets $ cmdProperty "systemctl" ["mask", n]
+ `assume` NoChange
+ `describe` ("service " ++ n ++ " masked")
+ systemdUnmask = tightenTargets $ cmdProperty "systemctl" ["unmask", n]
+ `assume` NoChange
+ `describe` ("service " ++ n ++ " unmasked")
+
+-- | Ensures that a service is both enabled and started
+running :: ServiceName -> Property Linux
+running n = started n `requires` enabled n
+
+-- | Restarts a systemd service.
+restarted :: ServiceName -> Property Linux
+restarted n = tightenTargets $ cmdProperty "systemctl" ["restart", n]
+ `assume` NoChange
+ `describe` ("service " ++ n ++ " restarted")
+
+-- | The systemd-networkd service.
+networkd :: ServiceName
+networkd = "systemd-networkd"
+
+-- | The systemd-journald service.
+journald :: ServiceName
+journald = "systemd-journald"
+
+-- | The systemd-logind service.
+logind :: ServiceName
+logind = "systemd-logind"
+
+-- | Enables persistent storage of the journal.
+persistentJournal :: Property DebianLike
+persistentJournal = check (not <$> doesDirectoryExist dir) $
+ combineProperties "persistent systemd journal" $ props
+ & cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
+ `assume` MadeChange
+ & Apt.installed ["acl"]
+ & cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
+ `assume` MadeChange
+ & started "systemd-journal-flush"
+ where
+ dir = "/var/log/journal"
+
+type Option = String
+
+-- | Ensures that an option is configured in one of systemd's config files.
+-- Does not ensure that the relevant daemon notices the change immediately.
+--
+-- This assumes that there is only one [Header] per file, which is
+-- currently the case for files like journald.conf and system.conf.
+-- And it assumes the file already exists with
+-- the right [Header], so new lines can just be appended to the end.
+configured :: FilePath -> Option -> String -> Property Linux
+configured cfgfile option value = tightenTargets $ combineProperties desc $ props
+ & File.fileProperty desc (mapMaybe removeother) cfgfile
+ & File.containsLine cfgfile line
+ where
+ setting = option ++ "="
+ line = setting ++ value
+ desc = cfgfile ++ " " ++ line
+ removeother l
+ | setting `isPrefixOf` l && l /= line = Nothing
+ | otherwise = Just l
+
+-- | Causes systemd to reload its configuration files.
+daemonReloaded :: Property Linux
+daemonReloaded = tightenTargets $ cmdProperty "systemctl" ["daemon-reload"]
+ `assume` NoChange
+
+-- | Configures journald, restarting it so the changes take effect.
+journaldConfigured :: Option -> String -> Property Linux
+journaldConfigured option value =
+ configured "/etc/systemd/journald.conf" option value
+ `onChange` restarted journald
+
+-- | Configures logind, restarting it so the changes take effect.
+logindConfigured :: Option -> String -> Property Linux
+logindConfigured option value =
+ configured "/etc/systemd/logind.conf" option value
+ `onChange` restarted logind
+
+-- | Configures whether leftover processes started from the
+-- user's login session are killed after the user logs out.
+--
+-- The default configuration varies depending on the version of systemd.
+--
+-- Revert the property to ensure that screen sessions etc keep running:
+--
+-- > ! killUserProcesses
+killUserProcesses :: RevertableProperty Linux Linux
+killUserProcesses = set "yes" <!> set "no"
+ where
+ set = logindConfigured "KillUserProcesses"
+
+-- | Ensures machined and machinectl are installed
+machined :: Property Linux
+machined = withOS "machined installed" $ \w o ->
+ case o of
+ -- Split into separate debian package since systemd 225.
+ (Just (System (Debian suite) _))
+ | not (isStable suite) -> ensureProperty w $
+ Apt.installed ["systemd-container"]
+ _ -> noChange
+
+-- | Defines a container with a given machine name,
+-- and how to create its chroot if not already present.
+--
+-- Properties can be added to configure the Container. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
+--
+-- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props
+-- > & osDebian Unstable "amd64"
+-- > & Apt.installedRunning "apache2"
+-- > & ...
+container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
+container name mkchroot =
+ let c = Container name chroot h
+ in setContainerProps c $ containerProps c
+ &^ resolvConfed
+ &^ linkJournal
+ where
+ chroot = mkchroot (containerDir name)
+ h = Host name (containerProperties chroot) (containerInfo chroot)
+
+-- | Defines a container with a given machine name, with the chroot
+-- created using debootstrap.
+--
+-- Properties can be added to configure the Container. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
+--
+-- > debContainer "webserver" $ props
+-- > & osDebian Unstable "amd64"
+-- > & Apt.installedRunning "apache2"
+-- > & ...
+debContainer :: MachineName -> Props metatypes -> Container
+debContainer name ps = container name $ \d -> Chroot.debootstrapped mempty d ps
+
+-- | Runs a container using systemd-nspawn.
+--
+-- A systemd unit is set up for the container, so it will automatically
+-- be started on boot.
+--
+-- Systemd is automatically installed inside the container, and will
+-- communicate with the host's systemd. This allows systemctl to be used to
+-- examine the status of services running inside the container.
+--
+-- When the host system has persistentJournal enabled, journactl can be
+-- used to examine logs forwarded from the container.
+--
+-- Reverting this property stops the container, removes the systemd unit,
+-- and deletes the chroot and all its contents.
+nspawned :: Container -> RevertableProperty (HasInfo + Linux) Linux
+nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
+ p `describe` ("nspawned " ++ name)
+ where
+ p :: RevertableProperty (HasInfo + Linux) Linux
+ p = enterScript c
+ `before` chrootprovisioned
+ `before` nspawnService c (_chrootCfg $ fromInfo $ hostInfo h)
+ `before` containerprovisioned
+
+ -- Chroot provisioning is run in systemd-only mode,
+ -- which sets up the chroot and ensures systemd and dbus are
+ -- installed, but does not handle the other properties.
+ chrootprovisioned = Chroot.provisioned' (Chroot.propagateChrootInfo chroot) chroot True
+
+ -- Use nsenter to enter container and and run propellor to
+ -- finish provisioning.
+ containerprovisioned :: RevertableProperty Linux Linux
+ containerprovisioned =
+ tightenTargets (Chroot.propellChroot chroot (enterContainerProcess c) False)
+ <!>
+ doNothing
+
+ chroot = Chroot.Chroot loc builder h
+
+-- | Sets up the service file for the container, and then starts
+-- it running.
+nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
+nspawnService (Container name _ _) cfg = setup <!> teardown
+ where
+ service = nspawnServiceName name
+ servicefile = "/etc/systemd/system/multi-user.target.wants" </> service
+
+ servicefilecontent = do
+ ls <- lines <$> readFile "/lib/systemd/system/systemd-nspawn@.service"
+ return $ unlines $
+ "# deployed by propellor" : map addparams ls
+ addparams l
+ | "ExecStart=" `isPrefixOf` l = unwords $
+ [ "ExecStart = /usr/bin/systemd-nspawn"
+ , "--quiet"
+ , "--keep-unit"
+ , "--boot"
+ , "--directory=" ++ containerDir name
+ , "--machine=%i"
+ ] ++ nspawnServiceParams cfg
+ | otherwise = l
+
+ goodservicefile = (==)
+ <$> servicefilecontent
+ <*> catchDefaultIO "" (readFile servicefile)
+
+ writeservicefile :: Property Linux
+ writeservicefile = property servicefile $ makeChange $ do
+ c <- servicefilecontent
+ File.viaStableTmp (\t -> writeFile t c) servicefile
+
+ setupservicefile :: Property Linux
+ setupservicefile = check (not <$> goodservicefile) $
+ -- if it's running, it has the wrong configuration,
+ -- so stop it
+ stopped service
+ `requires` daemonReloaded
+ `requires` writeservicefile
+
+ setup :: Property Linux
+ setup = started service
+ `requires` setupservicefile
+ `requires` machined
+
+ teardown :: Property Linux
+ teardown = check (doesFileExist servicefile) $
+ disabled service `requires` stopped service
+
+nspawnServiceParams :: ChrootCfg -> [String]
+nspawnServiceParams NoChrootCfg = []
+nspawnServiceParams (SystemdNspawnCfg ps) =
+ M.keys $ M.filter id $ M.fromList ps
+
+-- | Installs a "enter-machinename" script that root can use to run a
+-- command inside the container.
+--
+-- This uses nsenter to enter the container, by looking up the pid of the
+-- container's init process and using its namespace.
+enterScript :: Container -> RevertableProperty Linux Linux
+enterScript c@(Container name _ _) =
+ tightenTargets setup <!> tightenTargets teardown
+ where
+ setup = combineProperties ("generated " ++ enterScriptFile c) $ props
+ & scriptfile `File.hasContent`
+ [ "#!/usr/bin/perl"
+ , "# Generated by propellor"
+ , "my $pid=`machinectl show " ++ shellEscape name ++ " -p Leader | cut -d= -f2`;"
+ , "chomp $pid;"
+ , "if (length $pid) {"
+ , "\tforeach my $var (keys %ENV) {"
+ , "\t\tdelete $ENV{$var} unless $var eq 'PATH' || $var eq 'TERM';"
+ , "\t}"
+ , "\texec('nsenter', '-p', '-u', '-n', '-i', '-m', '-t', $pid, @ARGV);"
+ , "} else {"
+ , "\tdie 'container not running';"
+ , "}"
+ , "exit(1);"
+ ]
+ & scriptfile `File.mode` combineModes (readModes ++ executeModes)
+ teardown = File.notPresent scriptfile
+ scriptfile = enterScriptFile c
+
+enterScriptFile :: Container -> FilePath
+enterScriptFile (Container name _ _ ) = "/usr/local/bin/enter-" ++ mungename name
+
+enterContainerProcess :: Container -> [String] -> IO (CreateProcess, IO ())
+enterContainerProcess c ps = pure (proc (enterScriptFile c) ps, noop)
+
+nspawnServiceName :: MachineName -> ServiceName
+nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service"
+
+containerDir :: MachineName -> FilePath
+containerDir name = "/var/lib/container" </> mungename name
+
+mungename :: MachineName -> String
+mungename = replace "/" "_"
+
+-- | This configures how systemd-nspawn(1) starts the container,
+-- by specifying a parameter, such as "--private-network", or
+-- "--link-journal=guest"
+--
+-- When there is no leading dash, "--" is prepended to the parameter.
+--
+-- Reverting the property will remove a parameter, if it's present.
+containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
+containerCfg p = RevertableProperty (mk True) (mk False)
+ where
+ mk b = tightenTargets $
+ pureInfoProperty desc $
+ mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
+ where
+ desc = "container configuration " ++ (if b then "" else "without ") ++ p'
+ p' = case p of
+ ('-':_) -> p
+ _ -> "--" ++ p
+
+-- | Bind mounts </etc/resolv.conf> from the host into the container.
+--
+-- This property is enabled by default. Revert it to disable it.
+resolvConfed :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
+resolvConfed = containerCfg "bind=/etc/resolv.conf"
+
+-- | Link the container's journal to the host's if possible.
+-- (Only works if the host has persistent journal enabled.)
+--
+-- This property is enabled by default. Revert it to disable it.
+linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
+linkJournal = containerCfg "link-journal=try-guest"
+
+-- | Disconnect networking of the container from the host.
+privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
+privateNetwork = containerCfg "private-network"
+
+class Publishable a where
+ toPublish :: a -> String
+
+instance Publishable Port where
+ toPublish port = fromPort port
+
+instance Publishable (Bound Port) where
+ toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)
+
+data Proto = TCP | UDP
+
+instance Publishable (Proto, Bound Port) where
+ toPublish (TCP, fp) = "tcp:" ++ toPublish fp
+ toPublish (UDP, fp) = "udp:" ++ toPublish fp
+
+-- | Publish a port from the container to the host.
+--
+-- This feature was first added in systemd version 220.
+--
+-- This property is only needed (and will only work) if the container
+-- is configured to use private networking. Also, networkd should be enabled
+-- both inside the container, and on the host. For example:
+--
+-- > foo :: Host
+-- > foo = host "foo.example.com"
+-- > & Systemd.nspawned webserver
+-- > `requires` Systemd.running Systemd.networkd
+-- >
+-- > webserver :: Systemd.container
+-- > webserver = Systemd.container "webserver" (Chroot.debootstrapped mempty)
+-- > & os (System (Debian Testing) "amd64")
+-- > & Systemd.privateNetwork
+-- > & Systemd.running Systemd.networkd
+-- > & Systemd.publish (Port 80 ->- Port 8080)
+-- > & Apt.installedRunning "apache2"
+publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
+publish p = containerCfg $ "--port=" ++ toPublish p
+
+class Bindable a where
+ toBind :: a -> String
+
+instance Bindable FilePath where
+ toBind f = f
+
+instance Bindable (Bound FilePath) where
+ toBind v = hostSide v ++ ":" ++ containerSide v
+
+-- | Bind mount a file or directory from the host into the container.
+bind :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
+bind p = containerCfg $ "--bind=" ++ toBind p
+
+-- | Read-only mind mount.
+bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
+bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
diff --git a/src/Propellor/Property/Systemd/Core.hs b/src/Propellor/Property/Systemd/Core.hs
new file mode 100644
index 00000000..0290bce5
--- /dev/null
+++ b/src/Propellor/Property/Systemd/Core.hs
@@ -0,0 +1,10 @@
+module Propellor.Property.Systemd.Core where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+
+-- dbus is only a Recommends of systemd, but is needed for communication
+-- from the systemd inside a container to the one outside, so make sure it
+-- gets installed.
+installed :: Property DebianLike
+installed = Apt.installed ["systemd", "dbus"]
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 409bb63e..92dbd507 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -1,20 +1,190 @@
+{-# LANGUAGE TypeFamilies #-}
+
module Propellor.Property.Tor where
-import Propellor
+import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.ConfFile as ConfFile
+import Utility.FileMode
+import Utility.DataUnits
+
+import System.Posix.Files
+import Data.Char
+import Data.List
+
+type HiddenServiceName = String
+
+type NodeName = String
-isBridge :: Property
-isBridge = setup `requires` Apt.installed ["tor"]
+-- | Sets up a tor bridge. (Not a relay or exit node.)
+--
+-- Uses port 443
+isBridge :: Property DebianLike
+isBridge = configured
+ [ ("BridgeRelay", "1")
+ , ("Exitpolicy", "reject *:*")
+ , ("ORPort", "443")
+ ]
`describe` "tor bridge"
+ `requires` server
+
+-- | Sets up a tor relay.
+--
+-- Uses port 443
+isRelay :: Property DebianLike
+isRelay = configured
+ [ ("BridgeRelay", "0")
+ , ("Exitpolicy", "reject *:*")
+ , ("ORPort", "443")
+ ]
+ `describe` "tor relay"
+ `requires` server
+
+-- | Makes the tor node be named, with a known private key.
+--
+-- This can be moved to a different IP without needing to wait to
+-- accumulate trust.
+named :: NodeName -> Property (HasInfo + DebianLike)
+named n = configured [("Nickname", n')]
+ `describe` ("tor node named " ++ n')
+ `requires` torPrivKey (Context ("tor " ++ n))
+ where
+ n' = saneNickname n
+
+torPrivKey :: Context -> Property (HasInfo + DebianLike)
+torPrivKey context = f `File.hasPrivContent` context
+ `onChange` File.ownerGroup f user (userGroup user)
+ `requires` torPrivKeyDirExists
where
- setup = "/etc/tor/torrc" `File.hasContent`
- [ "SocksPort 0"
- , "ORPort 443"
- , "BridgeRelay 1"
- , "Exitpolicy reject *:*"
- ] `onChange` restarted
+ f = torPrivKeyDir </> "secret_id_key"
+
+torPrivKeyDirExists :: Property DebianLike
+torPrivKeyDirExists = File.dirExists torPrivKeyDir
+ `onChange` setperms
+ `requires` installed
+ where
+ setperms = File.ownerGroup torPrivKeyDir user (userGroup user)
+ `before` File.mode torPrivKeyDir 0O2700
+
+torPrivKeyDir :: FilePath
+torPrivKeyDir = "/var/lib/tor/keys"
+
+-- | A tor server (bridge, relay, or exit)
+-- Don't use if you just want to run tor for personal use.
+server :: Property DebianLike
+server = configured [("SocksPort", "0")]
+ `requires` installed
+ `requires` Apt.installed ["ntp"]
+ `describe` "tor server"
+
+installed :: Property DebianLike
+installed = Apt.installed ["tor"]
+
+-- | Specifies configuration settings. Any lines in the config file
+-- that set other values for the specified settings will be removed,
+-- while other settings are left as-is. Tor is restarted when
+-- configuration is changed.
+configured :: [(String, String)] -> Property DebianLike
+configured settings = File.fileProperty "tor configured" go mainConfig
+ `onChange` restarted
+ where
+ ks = map fst settings
+ go ls = sort $ map toconfig $
+ filter (\(k, _) -> k `notElem` ks) (map fromconfig ls)
+ ++ settings
+ toconfig (k, v) = k ++ " " ++ v
+ fromconfig = separate (== ' ')
+
+data BwLimit
+ = PerSecond String
+ | PerDay String
+ | PerMonth String
-restarted :: Property
+-- | Limit incoming and outgoing traffic to the specified
+-- amount each.
+--
+-- For example, PerSecond "30 kibibytes" is the minimum limit
+-- for a useful relay.
+bandwidthRate :: BwLimit -> Property DebianLike
+bandwidthRate (PerSecond s) = bandwidthRate' s 1
+bandwidthRate (PerDay s) = bandwidthRate' s (24*60*60)
+bandwidthRate (PerMonth s) = bandwidthRate' s (31*24*60*60)
+
+bandwidthRate' :: String -> Integer -> Property DebianLike
+bandwidthRate' s divby = case readSize dataUnits s of
+ Just sz -> let v = show (sz `div` divby) ++ " bytes"
+ in configured [("BandwidthRate", v)]
+ `describe` ("tor BandwidthRate " ++ v)
+ Nothing -> property ("unable to parse " ++ s) noChange
+
+hiddenServiceAvailable :: HiddenServiceName -> Int -> Property DebianLike
+hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port
+ where
+ hiddenServiceHostName p = adjustPropertySatisfy p $ \satisfy -> do
+ r <- satisfy
+ h <- liftIO $ readFile (varLib </> hn </> "hostname")
+ warningMessage $ unwords ["hidden service hostname:", h]
+ return r
+
+hiddenService :: HiddenServiceName -> Int -> Property DebianLike
+hiddenService hn port = ConfFile.adjustSection
+ (unwords ["hidden service", hn, "available on port", show port])
+ (== oniondir)
+ (not . isPrefixOf "HiddenServicePort")
+ (const [oniondir, onionport])
+ (++ [oniondir, onionport])
+ mainConfig
+ `onChange` restarted
+ where
+ oniondir = unwords ["HiddenServiceDir", varLib </> hn]
+ onionport = unwords ["HiddenServicePort", show port, "127.0.0.1:" ++ show port]
+
+hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property (HasInfo + DebianLike)
+hiddenServiceData hn context = combineProperties desc $ props
+ & installonion "hostname"
+ & installonion "private_key"
+ where
+ desc = unwords ["hidden service data available in", varLib </> hn]
+ installonion :: FilePath -> Property (HasInfo + DebianLike)
+ installonion f = withPrivData (PrivFile $ varLib </> hn </> f) context $ \getcontent ->
+ property' desc $ \w -> getcontent $ install w $ varLib </> hn </> f
+ install w f privcontent = ifM (liftIO $ doesFileExist f)
+ ( noChange
+ , ensureProperty w $ propertyList desc $ toProps
+ [ property desc $ makeChange $ do
+ createDirectoryIfMissing True (takeDirectory f)
+ writeFileProtected f (unlines (privDataLines privcontent))
+ , File.mode (takeDirectory f) $ combineModes
+ [ownerReadMode, ownerWriteMode, ownerExecuteMode]
+ , File.ownerGroup (takeDirectory f) user (userGroup user)
+ , File.ownerGroup f user (userGroup user)
+ ]
+ )
+
+restarted :: Property DebianLike
restarted = Service.restarted "tor"
+
+mainConfig :: FilePath
+mainConfig = "/etc/tor/torrc"
+
+varLib :: FilePath
+varLib = "/var/lib/tor"
+
+varRun :: FilePath
+varRun = "/var/run/tor"
+
+user :: User
+user = User "debian-tor"
+
+type NickName = String
+
+-- | Convert String to a valid tor NickName.
+saneNickname :: String -> NickName
+saneNickname s
+ | null n = "unnamed"
+ | otherwise = n
+ where
+ legal c = isNumber c || isAsciiUpper c || isAsciiLower c
+ n = take 19 $ filter legal s
diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs
new file mode 100644
index 00000000..23a5b30d
--- /dev/null
+++ b/src/Propellor/Property/Unbound.hs
@@ -0,0 +1,142 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+--
+-- Properties for the Unbound caching DNS server
+
+module Propellor.Property.Unbound
+ ( installed
+ , restarted
+ , reloaded
+ , UnboundSection
+ , UnboundZone
+ , UnboundHost
+ , UnboundSetting
+ , UnboundValue
+ , UnboundKey
+ , ConfSection
+ , ZoneType
+ , cachingDnsServer
+ ) where
+
+import Propellor.Base
+import Propellor.Property.File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+import Data.List (find)
+
+
+type ConfSection = String
+
+type UnboundSetting = (UnboundKey, UnboundValue)
+
+type UnboundSection = (ConfSection, [UnboundSetting])
+
+type UnboundZone = (BindDomain, ZoneType)
+
+type UnboundHost = (BindDomain, Record)
+
+type UnboundKey = String
+
+type UnboundValue = String
+
+type ZoneType = String
+
+installed :: Property DebianLike
+installed = Apt.installed ["unbound"]
+
+restarted :: Property DebianLike
+restarted = Service.restarted "unbound"
+
+reloaded :: Property DebianLike
+reloaded = Service.reloaded "unbound"
+
+dValue :: BindDomain -> String
+dValue (RelDomain d) = d
+dValue (AbsDomain d) = d ++ "."
+dValue (RootDomain) = "@"
+
+sectionHeader :: ConfSection -> String
+sectionHeader header = header ++ ":"
+
+config :: FilePath
+config = "/etc/unbound/unbound.conf.d/propellor.conf"
+
+-- | Provided a [UnboundSection], a [UnboundZone] and a [UnboundHost],
+-- cachingDnsServer ensure unbound is configured accordingly.
+--
+-- Example property:
+--
+-- > cachingDnsServer
+-- > [ ("remote-control", [("control-enable", "no")]
+-- > , ("server",
+-- > [ ("interface", "0.0.0.0")
+-- > , ("access-control", "192.168.1.0/24 allow")
+-- > , ("do-tcp", "no")
+-- > ])
+-- > [ (AbsDomain "example.com", "transparent")
+-- > , (AbsDomain $ reverseIP $ IPv4 "192.168.1", "static")
+-- > ]
+-- > [ (AbsDomain "example.com", Address $ IPv4 "192.168.1.2")
+-- > , (AbsDomain "myhost.example.com", Address $ IPv4 "192.168.1.2")
+-- > , (AbsDomain "myrouter.example.com", Address $ IPv4 "192.168.1.1")
+-- > , (AbsDomain "www.example.com", Address $ IPv4 "192.168.1.2")
+-- > , (AbsDomain "example.com", MX 10 "mail.example.com")
+-- > , (AbsDomain "mylaptop.example.com", Address $ IPv4 "192.168.1.2")
+-- > -- ^ connected via ethernet
+-- > , (AbsDomain "mywifi.example.com", Address $ IPv4 "192.168.2.1")
+-- > , (AbsDomain "mylaptop.example.com", Address $ IPv4 "192.168.2.2")
+-- > -- ^ connected via wifi, use round robin
+-- > , (AbsDomain "myhost.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
+-- > , (AbsDomain "myrouter.example.com", PTR $ reverseIP $ IPv4 "192.168.1.1")
+-- > , (AbsDomain "mylaptop.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
+-- > ]
+cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property DebianLike
+cachingDnsServer sections zones hosts =
+ config `hasContent` (comment : otherSections ++ serverSection)
+ `onChange` restarted
+ where
+ comment = "# deployed with propellor, do not modify"
+ serverSection = genSection (fromMaybe ("server", []) $ find ((== "server") . fst) sections)
+ ++ map genZone zones
+ ++ map (uncurry genRecord') hosts
+ otherSections = foldr ((++) . genSection) [] $ filter ((/= "server") . fst) sections
+
+genSection :: UnboundSection -> [Line]
+genSection (section, settings) = sectionHeader section : map genSetting settings
+
+genSetting :: UnboundSetting -> Line
+genSetting (key, value) = " " ++ key ++ ": " ++ value
+
+genZone :: UnboundZone -> Line
+genZone (dom, zt) = " local-zone: \"" ++ dValue dom ++ "\" " ++ zt
+
+genRecord' :: BindDomain -> Record -> Line
+genRecord' dom r = " local-data: \"" ++ fromMaybe "" (genRecord dom r) ++ "\""
+
+genRecord :: BindDomain -> Record -> Maybe String
+genRecord dom (Address addr) = Just $ genAddressNoTtl dom addr
+genRecord dom (MX priority dest) = Just $ genMX dom priority dest
+genRecord dom (PTR revip) = Just $ genPTR dom revip
+genRecord _ (CNAME _) = Nothing
+genRecord _ (NS _) = Nothing
+genRecord _ (TXT _) = Nothing
+genRecord _ (SRV _ _ _ _) = Nothing
+genRecord _ (SSHFP _ _ _) = Nothing
+genRecord _ (INCLUDE _) = Nothing
+
+genAddressNoTtl :: BindDomain -> IPAddr -> String
+genAddressNoTtl dom = genAddress dom Nothing
+
+genAddress :: BindDomain -> Maybe Int -> IPAddr -> String
+genAddress dom ttl addr = case addr of
+ IPv4 _ -> genAddress' "A" dom ttl addr
+ IPv6 _ -> genAddress' "AAAA" dom ttl addr
+
+genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String
+genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> show ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr
+
+genMX :: BindDomain -> Int -> BindDomain -> String
+genMX dom priority dest = dValue dom ++ " " ++ "MX" ++ " " ++ show priority ++ " " ++ dValue dest
+
+genPTR :: BindDomain -> ReverseIP -> String
+genPTR dom revip = revip ++ ". " ++ "PTR" ++ " " ++ dValue dom
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index f9c400a8..76eae647 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -2,61 +2,204 @@ module Propellor.Property.User where
import System.Posix
-import Propellor
+import Propellor.Base
+import qualified Propellor.Property.File as File
data Eep = YesReallyDeleteHome
-accountFor :: UserName -> Property
-accountFor user = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser"
- [ "--disabled-password"
- , "--gecos", ""
- , user
- ]
- `describe` ("account for " ++ user)
+accountFor :: User -> Property DebianLike
+accountFor user@(User u) = tightenTargets $ check nohomedir go
+ `describe` ("account for " ++ u)
+ where
+ nohomedir = isNothing <$> catchMaybeIO (homedir user)
+ go = cmdProperty "adduser"
+ [ "--disabled-password"
+ , "--gecos", ""
+ , u
+ ]
+
+systemAccountFor :: User -> Property DebianLike
+systemAccountFor user@(User u) = systemAccountFor' user Nothing (Just (Group u))
+
+systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike
+systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go
+ `describe` ("system account for " ++ u)
+ where
+ nouser = isNothing <$> catchMaybeIO (getUserEntryForName u)
+ go = cmdProperty "adduser" $
+ [ "--system" ]
+ ++
+ "--home" : maybe
+ ["/nonexistent", "--no-create-home"]
+ ( \h -> [ h ] )
+ mhome
+ ++
+ maybe [] ( \(Group g) -> ["--ingroup", g] ) mgroup
+ ++
+ [ "--shell", "/usr/bin/nologin"
+ , "--disabled-login"
+ , "--disabled-password"
+ , u
+ ]
-- | Removes user home directory!! Use with caution.
-nuked :: UserName -> Eep -> Property
-nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel"
- [ "-r"
- , user
- ]
- `describe` ("nuked user " ++ user)
+nuked :: User -> Eep -> Property DebianLike
+nuked user@(User u) _ = tightenTargets $ check hashomedir go
+ `describe` ("nuked user " ++ u)
+ where
+ hashomedir = isJust <$> catchMaybeIO (homedir user)
+ go = cmdProperty "userdel"
+ [ "-r"
+ , u
+ ]
-- | Only ensures that the user has some password set. It may or may
--- not be the password from the PrivData.
-hasSomePassword :: UserName -> Context -> Property
-hasSomePassword user context = check ((/= HasPassword) <$> getPasswordStatus user) $
- hasPassword user context
-
-hasPassword :: UserName -> Context -> Property
-hasPassword user context = withPrivData (Password user) context $ \getpassword ->
- property (user ++ " has password") $
- getpassword $ \password -> makeChange $
- withHandle StdinHandle createProcessSuccess
- (proc "chpasswd" []) $ \h -> do
- hPutStrLn h $ user ++ ":" ++ password
- hClose h
-
-lockedPassword :: UserName -> Property
-lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
- [ "--lock"
- , user
- ]
- `describe` ("locked " ++ user ++ " password")
+-- not be a password from the PrivData.
+hasSomePassword :: User -> Property (HasInfo + DebianLike)
+hasSomePassword user = hasSomePassword' user hostContext
+
+-- | While hasSomePassword uses the name of the host as context,
+-- this allows specifying a different context. This is useful when
+-- you want to use the same password on multiple hosts, for example.
+hasSomePassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike)
+hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $
+ hasPassword' user context
+
+-- | Ensures that a user's password is set to a password from the PrivData.
+-- (Will change any existing password.)
+--
+-- A user's password can be stored in the PrivData in either of two forms;
+-- the full cleartext <Password> or a <CryptPassword> hash. The latter
+-- is obviously more secure.
+hasPassword :: User -> Property (HasInfo + DebianLike)
+hasPassword user = hasPassword' user hostContext
+
+hasPassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike)
+hasPassword' (User u) context = go
+ `requires` shadowConfig True
+ where
+ go :: Property (HasInfo + UnixLike)
+ go = withSomePrivData srcs context $
+ property (u ++ " has password") . setPassword
+ srcs =
+ [ PrivDataSource (CryptPassword u)
+ "a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'"
+ , PrivDataSource (Password u) ("a password for " ++ u)
+ ]
+
+setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
+setPassword getpassword = getpassword $ go
+ where
+ go (Password user, password) = chpasswd (User user) (privDataVal password) []
+ go (CryptPassword user, hash) = chpasswd (User user) (privDataVal hash) ["--encrypted"]
+ go (f, _) = error $ "Unexpected type of privdata: " ++ show f
+
+-- | Makes a user's password be the passed String. Highly insecure:
+-- The password is right there in your config file for anyone to see!
+hasInsecurePassword :: User -> String -> Property DebianLike
+hasInsecurePassword u@(User n) p = property (n ++ " has insecure password") $
+ chpasswd u p []
+
+chpasswd :: User -> String -> [String] -> Propellor Result
+chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuccess
+ (proc "chpasswd" ps) $ \h -> do
+ hPutStrLn h $ user ++ ":" ++ v
+ hClose h
+
+lockedPassword :: User -> Property DebianLike
+lockedPassword user@(User u) = tightenTargets $
+ check (not <$> isLockedPassword user) go
+ `describe` ("locked " ++ u ++ " password")
+ where
+ go = cmdProperty "passwd"
+ [ "--lock"
+ , u
+ ]
data PasswordStatus = NoPassword | LockedPassword | HasPassword
deriving (Eq)
-getPasswordStatus :: UserName -> IO PasswordStatus
-getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user]
+getPasswordStatus :: User -> IO PasswordStatus
+getPasswordStatus (User u) = parse . words <$> readProcess "passwd" ["-S", u]
where
parse (_:"L":_) = LockedPassword
parse (_:"NP":_) = NoPassword
parse (_:"P":_) = HasPassword
parse _ = NoPassword
-isLockedPassword :: UserName -> IO Bool
+isLockedPassword :: User -> IO Bool
isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
-homedir :: UserName -> IO FilePath
-homedir user = homeDirectory <$> getUserEntryForName user
+homedir :: User -> IO FilePath
+homedir (User user) = homeDirectory <$> getUserEntryForName user
+
+hasGroup :: User -> Group -> Property DebianLike
+hasGroup (User user) (Group group') = tightenTargets $ check test go
+ `describe` unwords ["user", user, "in group", group']
+ where
+ test = not . elem group' . words <$> readProcess "groups" [user]
+ go = cmdProperty "adduser"
+ [ user
+ , group'
+ ]
+
+-- | Gives a user access to the secondary groups, including audio and
+-- video, that the OS installer normally gives a desktop user access to.
+--
+-- Note that some groups may only exit after installation of other
+-- software. When a group does not exist yet, the user won't be added to it.
+hasDesktopGroups :: User -> Property DebianLike
+hasDesktopGroups user@(User u) = property' desc $ \o -> do
+ existinggroups <- map (fst . break (== ':')) . lines
+ <$> liftIO (readFile "/etc/group")
+ let toadd = filter (`elem` existinggroups) desktopgroups
+ ensureProperty o $ propertyList desc $ toProps $
+ map (hasGroup user . Group) toadd
+ where
+ desc = "user " ++ u ++ " is in standard desktop groups"
+ -- This list comes from user-setup's debconf
+ -- template named "passwd/user-default-groups"
+ desktopgroups =
+ [ "audio"
+ , "cdrom"
+ , "dip"
+ , "floppy"
+ , "video"
+ , "plugdev"
+ , "netdev"
+ , "scanner"
+ , "bluetooth"
+ , "debian-tor"
+ , "lpadmin"
+ ]
+
+-- | Controls whether shadow passwords are enabled or not.
+shadowConfig :: Bool -> Property DebianLike
+shadowConfig True = tightenTargets $ check (not <$> shadowExists)
+ (cmdProperty "shadowconfig" ["on"])
+ `describe` "shadow passwords enabled"
+shadowConfig False = tightenTargets $ check shadowExists
+ (cmdProperty "shadowconfig" ["off"])
+ `describe` "shadow passwords disabled"
+
+shadowExists :: IO Bool
+shadowExists = doesFileExist "/etc/shadow"
+
+-- | Ensures that a user has a specified login shell, and that the shell
+-- is enabled in /etc/shells.
+hasLoginShell :: User -> FilePath -> Property DebianLike
+hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell
+
+shellSetTo :: User -> FilePath -> Property DebianLike
+shellSetTo (User u) loginshell = tightenTargets $ check needchangeshell
+ (cmdProperty "chsh" ["--shell", loginshell, u])
+ `describe` (u ++ " has login shell " ++ loginshell)
+ where
+ needchangeshell = do
+ currshell <- userShell <$> getUserEntryForName u
+ return (currshell /= loginshell)
+
+-- | Ensures that /etc/shells contains a shell.
+shellEnabled :: FilePath -> Property DebianLike
+shellEnabled loginshell = tightenTargets $
+ "/etc/shells" `File.containsLine` loginshell
diff --git a/src/Propellor/Property/Uwsgi.hs b/src/Propellor/Property/Uwsgi.hs
new file mode 100644
index 00000000..4eb94103
--- /dev/null
+++ b/src/Propellor/Property/Uwsgi.hs
@@ -0,0 +1,49 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+
+module Propellor.Property.Uwsgi where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+type ConfigFile = [String]
+
+type AppName = String
+
+appEnabled :: AppName -> ConfigFile -> RevertableProperty DebianLike DebianLike
+appEnabled an cf = enable <!> disable
+ where
+ enable = appVal an `File.isSymlinkedTo` appValRelativeCfg an
+ `describe` ("uwsgi app enabled " ++ an)
+ `requires` appAvailable an cf
+ `requires` installed
+ `onChange` reloaded
+ disable = File.notPresent (appVal an)
+ `describe` ("uwsgi app disable" ++ an)
+ `requires` installed
+ `onChange` reloaded
+
+appAvailable :: AppName -> ConfigFile -> Property DebianLike
+appAvailable an cf = ("uwsgi app available " ++ an) ==>
+ tightenTargets (appCfg an `File.hasContent` (comment : cf))
+ where
+ comment = "# deployed with propellor, do not modify"
+
+appCfg :: AppName -> FilePath
+appCfg an = "/etc/uwsgi/apps-available" </> an <.> "ini"
+
+appVal :: AppName -> FilePath
+appVal an = "/etc/uwsgi/apps-enabled/" </> an <.> "ini"
+
+appValRelativeCfg :: AppName -> File.LinkTarget
+appValRelativeCfg an = File.LinkTarget $ "../apps-available" </> an <.> "ini"
+
+installed :: Property DebianLike
+installed = Apt.installed ["uwsgi"]
+
+restarted :: Property DebianLike
+restarted = Service.restarted "uwsgi"
+
+reloaded :: Property DebianLike
+reloaded = Service.reloaded "uwsgi"
diff --git a/src/Propellor/Property/ZFS.hs b/src/Propellor/Property/ZFS.hs
new file mode 100644
index 00000000..7118a515
--- /dev/null
+++ b/src/Propellor/Property/ZFS.hs
@@ -0,0 +1,11 @@
+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
+--
+-- ZFS properties
+
+module Propellor.Property.ZFS (
+ module Propellor.Property.ZFS.Properties,
+ module Propellor.Types.ZFS
+) where
+
+import Propellor.Property.ZFS.Properties
+import Propellor.Types.ZFS
diff --git a/src/Propellor/Property/ZFS/Process.hs b/src/Propellor/Property/ZFS/Process.hs
new file mode 100644
index 00000000..372bac6d
--- /dev/null
+++ b/src/Propellor/Property/ZFS/Process.hs
@@ -0,0 +1,32 @@
+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
+--
+-- Functions running zfs processes.
+
+module Propellor.Property.ZFS.Process where
+
+import Propellor.Base
+import Data.String.Utils (split)
+import Data.List
+
+-- | Gets the properties of a ZFS volume.
+zfsGetProperties :: ZFS -> IO ZFSProperties
+zfsGetProperties z =
+ let plist = fromPropertyList . map (\(_:k:v:_) -> (k, v)) . (map (split "\t"))
+ in plist <$> runZfs "get" [Just "-H", Just "-p", Just "all"] z
+
+zfsExists :: ZFS -> IO Bool
+zfsExists z = any id . map (isInfixOf (zfsName z))
+ <$> runZfs "list" [Just "-H"] z
+
+-- | Runs the zfs command with the arguments.
+--
+-- Runs the command with -H which will skip the header line and
+-- separate all fields with tabs.
+--
+-- Replaces Nothing in the argument list with the ZFS pool/dataset.
+runZfs :: String -> [Maybe String] -> ZFS -> IO [String]
+runZfs cmd args z = lines <$> uncurry readProcess (zfsCommand cmd args z)
+
+-- | Return the ZFS command line suitable for readProcess or cmdProperty.
+zfsCommand :: String -> [Maybe String] -> ZFS -> (String, [String])
+zfsCommand cmd args z = ("zfs", cmd:(map (maybe (zfsName z) id) args))
diff --git a/src/Propellor/Property/ZFS/Properties.hs b/src/Propellor/Property/ZFS/Properties.hs
new file mode 100644
index 00000000..47d5a9d1
--- /dev/null
+++ b/src/Propellor/Property/ZFS/Properties.hs
@@ -0,0 +1,40 @@
+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
+--
+-- Functions defining zfs Properties.
+
+module Propellor.Property.ZFS.Properties (
+ ZFSOS,
+ zfsExists,
+ zfsSetProperties
+) where
+
+import Propellor.Base
+import Data.List (intercalate)
+import qualified Propellor.Property.ZFS.Process as ZP
+
+-- | OS's that support ZFS
+type ZFSOS = Linux + FreeBSD
+
+-- | Will ensure that a ZFS volume exists with the specified mount point.
+-- This requires the pool to exist as well, but we don't create pools yet.
+zfsExists :: ZFS -> Property ZFSOS
+zfsExists z = check (not <$> ZP.zfsExists z) create
+ `describe` unwords ["Creating", zfsName z]
+ where
+ (p, a) = ZP.zfsCommand "create" [Nothing] z
+ create = cmdProperty p a
+
+-- | Sets the given properties. Returns True if all were successfully changed, False if not.
+zfsSetProperties :: ZFS -> ZFSProperties -> Property ZFSOS
+zfsSetProperties z setProperties = setall
+ `requires` zfsExists z
+ where
+ spcmd :: String -> String -> (String, [String])
+ spcmd p v = ZP.zfsCommand "set" [Just (intercalate "=" [p, v]), Nothing] z
+
+ setprop :: (String, String) -> Property ZFSOS
+ setprop (p, v) = check (ZP.zfsExists z) $
+ cmdProperty (fst (spcmd p v)) (snd (spcmd p v))
+
+ setall = combineProperties (unwords ["Setting properties on", zfsName z]) $
+ toProps $ map setprop $ toPropertyList setProperties
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
new file mode 100644
index 00000000..e90155f3
--- /dev/null
+++ b/src/Propellor/Protocol.hs
@@ -0,0 +1,72 @@
+-- | This is a simple line-based protocol used for communication between
+-- a local and remote propellor. It's sent over a ssh channel, and lines of
+-- the protocol can be interspersed with other, non-protocol lines
+-- that should be passed through to be displayed.
+--
+-- Avoid making backwards-incompatible changes to this protocol,
+-- since propellor needs to use this protocol to update itself to new
+-- versions speaking newer versions of the protocol.
+
+module Propellor.Protocol where
+
+import Data.List
+
+import Propellor.Base
+
+data Stage = NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush | NeedPrecompiled
+ deriving (Read, Show, Eq)
+
+type Marker = String
+type Marked = String
+
+statusMarker :: Marker
+statusMarker = "STATUS"
+
+privDataMarker :: String
+privDataMarker = "PRIVDATA "
+
+repoUrlMarker :: String
+repoUrlMarker = "REPOURL "
+
+gitPushMarker :: String
+gitPushMarker = "GITPUSH"
+
+toMarked :: Marker -> String -> String
+toMarked = (++)
+
+fromMarked :: Marker -> Marked -> Maybe String
+fromMarked marker s
+ | marker `isPrefixOf` s = Just $ drop (length marker) s
+ | otherwise = Nothing
+
+sendMarked :: Handle -> Marker -> String -> IO ()
+sendMarked h marker s = do
+ debug ["sent marked", marker]
+ sendMarked' h marker s
+
+sendMarked' :: Handle -> Marker -> String -> IO ()
+sendMarked' h marker s = do
+ -- Prefix string with newline because sometimes a
+ -- incomplete line has been output, and the marker needs to
+ -- come at the start of a line.
+ hPutStrLn h ("\n" ++ toMarked marker s)
+ hFlush h
+
+getMarked :: Handle -> Marker -> IO (Maybe String)
+getMarked h marker = go =<< catchMaybeIO (hGetLine h)
+ where
+ go Nothing = return Nothing
+ go (Just l) = case fromMarked marker l of
+ Nothing -> do
+ unless (null l) $
+ hPutStrLn stderr l
+ getMarked h marker
+ Just v -> do
+ debug ["received marked", marker]
+ return (Just v)
+
+req :: Stage -> Marker -> (String -> IO ()) -> IO ()
+req stage marker a = do
+ debug ["requested marked", marker]
+ sendMarked' stdout statusMarker (show stage)
+ maybe noop a =<< getMarked stdin marker
diff --git a/src/Propellor/Property/Docker/Shim.hs b/src/Propellor/Shim.hs
index c2f35d0c..27545afb 100644
--- a/src/Propellor/Property/Docker/Shim.hs
+++ b/src/Propellor/Shim.hs
@@ -1,23 +1,26 @@
--- | Support for running propellor, as built outside a docker container,
--- inside the container.
+-- | Support for running propellor, as built outside a container,
+-- inside the container, without needing to install anything into the
+-- container.
--
-- Note: This is currently Debian specific, due to glibcLibs.
-module Propellor.Property.Docker.Shim (setup, cleanEnv, file) where
+module Propellor.Shim (setup, cleanEnv, file) where
-import Propellor
+import Propellor.Base
import Utility.LinuxMkLibs
-import Utility.SafeCommand
-import Utility.Path
import Utility.FileMode
+import Utility.FileSystemEncoding
import Data.List
import System.Posix.Files
-- | Sets up a shimmed version of the program, in a directory, and
-- returns its path.
-setup :: FilePath -> FilePath -> IO FilePath
-setup propellorbin dest = do
+--
+-- Propellor may be running from an existing shim, in which case it's
+-- simply reused.
+setup :: FilePath -> Maybe FilePath -> FilePath -> IO FilePath
+setup propellorbin propellorbinpath dest = checkAlreadyShimmed shim $ do
createDirectoryIfMissing True dest
libs <- parseLdd <$> readProcess "ldd" [propellorbin]
@@ -29,21 +32,41 @@ setup propellorbin dest = do
let linker = (dest ++) $
fromMaybe (error "cannot find ld-linux linker") $
headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
- let gconvdir = (dest ++) $ parentDir $
+ let linkersym = takeDirectory linker </> takeFileName propellorbin
+ createSymbolicLink (takeFileName linker) linkersym
+
+ let gconvdir = (dest ++) $ takeDirectory $
fromMaybe (error "cannot find gconv directory") $
headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
let linkerparams = ["--library-path", intercalate ":" libdirs ]
- let shim = file propellorbin dest
writeFile shim $ unlines
- [ "#!/bin/sh"
+ [ shebang
, "GCONV_PATH=" ++ shellEscape gconvdir
, "export GCONV_PATH"
- , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++
- " " ++ shellEscape propellorbin ++ " \"$@\""
+ , "exec " ++ unwords (map shellEscape $ linkersym : linkerparams) ++
+ " " ++ shellEscape (fromMaybe propellorbin propellorbinpath) ++ " \"$@\""
]
modifyFileMode shim (addModes executeModes)
return shim
+ where
+ shim = file propellorbin dest
+
+shebang :: String
+shebang = "#!/bin/sh"
+
+checkAlreadyShimmed :: FilePath -> IO FilePath -> IO FilePath
+checkAlreadyShimmed f nope = ifM (doesFileExist f)
+ ( withFile f ReadMode $ \h -> do
+ fileEncoding h
+ s <- hGetLine h
+ if s == shebang
+ then return f
+ else nope
+ , nope
+ )
+-- Called when the shimmed propellor is running, so that commands it runs
+-- don't see it.
cleanEnv :: IO ()
cleanEnv = void $ unsetEnv "GCONV_PATH"
@@ -54,8 +77,8 @@ installFile :: FilePath -> FilePath -> IO ()
installFile top f = do
createDirectoryIfMissing True destdir
nukeFile dest
- createLink f dest `catchIO` (const copy)
+ createLink f dest `catchIO` const copy
where
copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
- destdir = inTop top $ parentDir f
+ destdir = inTop top $ takeDirectory f
dest = inTop top f
diff --git a/src/Propellor/SimpleSh.hs b/src/Propellor/SimpleSh.hs
deleted file mode 100644
index cc5c62cd..00000000
--- a/src/Propellor/SimpleSh.hs
+++ /dev/null
@@ -1,101 +0,0 @@
--- | Simple server, using a named pipe. Client connects, sends a command,
--- and gets back all the output from the command, in a stream.
---
--- This is useful for eg, docker.
-
-module Propellor.SimpleSh where
-
-import Network.Socket
-import Control.Concurrent
-import Control.Concurrent.Async
-import System.Process (std_in, std_out, std_err)
-
-import Propellor
-import Utility.FileMode
-import Utility.ThreadScheduler
-
-data Cmd = Cmd String [String]
- deriving (Read, Show)
-
-data Resp = StdoutLine String | StderrLine String | Done
- deriving (Read, Show)
-
-simpleSh :: FilePath -> IO ()
-simpleSh namedpipe = do
- nukeFile namedpipe
- let dir = takeDirectory namedpipe
- createDirectoryIfMissing True dir
- modifyFileMode dir (removeModes otherGroupModes)
- s <- socket AF_UNIX Stream defaultProtocol
- bindSocket s (SockAddrUnix namedpipe)
- listen s 2
- forever $ do
- (client, _addr) <- accept s
- forkIO $ do
- h <- socketToHandle client ReadWriteMode
- maybe noop (run h) . readish =<< hGetLine h
- where
- run h (Cmd cmd params) = do
- chan <- newChan
- let runwriter = do
- v <- readChan chan
- hPutStrLn h (show v)
- hFlush h
- case v of
- Done -> noop
- _ -> runwriter
- writer <- async runwriter
-
- flip catchIO (\_e -> writeChan chan Done) $ do
- let p = (proc cmd params)
- { std_in = Inherit
- , std_out = CreatePipe
- , std_err = CreatePipe
- }
- (Nothing, Just outh, Just errh, pid) <- createProcess p
-
- let mkreader t from = maybe noop (const $ mkreader t from)
- =<< catchMaybeIO (writeChan chan . t =<< hGetLine from)
- void $ concurrently
- (mkreader StdoutLine outh)
- (mkreader StderrLine errh)
-
- void $ tryIO $ waitForProcess pid
-
- writeChan chan Done
-
- hClose outh
- hClose errh
-
- wait writer
- hClose h
-
-simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
-simpleShClient namedpipe cmd params handler = do
- s <- socket AF_UNIX Stream defaultProtocol
- connect s (SockAddrUnix namedpipe)
- h <- socketToHandle s ReadWriteMode
- hPutStrLn h $ show $ Cmd cmd params
- hFlush h
- resps <- catMaybes . map readish . lines <$> hGetContents h
- v <- hClose h `after` handler resps
- return v
-
-simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
-simpleShClientRetry retries namedpipe cmd params handler = go retries
- where
- run = simpleShClient namedpipe cmd params handler
- go n
- | n < 1 = run
- | otherwise = do
- v <- tryIO run
- case v of
- Right r -> return r
- Left e -> do
- debug ["simplesh connection retry", show e]
- threadDelaySeconds (Seconds 1)
- go (n - 1)
-
-getStdout :: Resp -> Maybe String
-getStdout (StdoutLine s) = Just s
-getStdout _ = Nothing
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
new file mode 100644
index 00000000..c6699961f
--- /dev/null
+++ b/src/Propellor/Spin.hs
@@ -0,0 +1,390 @@
+{-# Language ScopedTypeVariables #-}
+
+module Propellor.Spin (
+ commitSpin,
+ spin,
+ spin',
+ update,
+ gitPushHelper,
+ mergeSpin,
+) where
+
+import Data.List
+import System.Exit
+import System.PosixCompat
+import System.Posix.IO
+import System.Posix.Directory
+import Control.Concurrent.Async
+import qualified Data.ByteString as B
+import qualified Data.Set as S
+import Network.Socket (getAddrInfo, defaultHints, AddrInfo(..), AddrInfoFlag(..), SockAddr)
+
+import Propellor.Base
+import Propellor.Protocol
+import Propellor.PrivData.Paths
+import Propellor.Git
+import Propellor.Git.Config
+import Propellor.Ssh
+import Propellor.Gpg
+import Propellor.Bootstrap
+import Propellor.Types.CmdLine
+import Propellor.Types.Info
+import qualified Propellor.Shim as Shim
+import Utility.FileMode
+import Utility.SafeCommand
+import Utility.Process.NonConcurrent
+
+commitSpin :: IO ()
+commitSpin = do
+ -- safety check #1: check we're on the configured spin branch
+ spinBranch <- getGitConfigValue "propellor.spin-branch"
+ case spinBranch of
+ Nothing -> return () -- just a noop
+ Just b -> do
+ currentBranch <- getCurrentBranch
+ when (b /= currentBranch) $
+ error ("spin aborted: check out "
+ ++ b ++ " branch first")
+
+ -- safety check #2: check we can commit with a dirty tree
+ noDirtySpin <- getGitConfigBool "propellor.forbid-dirty-spin"
+ when noDirtySpin $ do
+ status <- takeWhile (/= '\n')
+ <$> readProcess "git" ["status", "--porcelain"]
+ when (not . null $ status) $
+ error "spin aborted: commit changes first"
+
+ void $ actionMessage "Git commit" $
+ gitCommit (Just spinCommitMessage)
+ [Param "--allow-empty", Param "-a"]
+ -- Push to central origin repo first, if possible.
+ -- The remote propellor will pull from there, which avoids
+ -- us needing to send stuff directly to the remote host.
+ whenM hasOrigin $
+ void $ actionMessage "Push to central git repository" $
+ boolSystemNonConcurrent "git" [Param "push"]
+
+spin :: Maybe HostName -> HostName -> Host -> IO ()
+spin = spin' Nothing
+
+spin' :: Maybe PrivMap -> Maybe HostName -> HostName -> Host -> IO ()
+spin' mprivdata relay target hst = do
+ cacheparams <- if viarelay
+ then pure ["-A"]
+ else toCommand <$> sshCachingParams hn
+ when viarelay $
+ void $ boolSystem "ssh-add" []
+
+ sshtarget <- ("root@" ++) <$> case relay of
+ Just r -> pure r
+ Nothing -> getSshTarget target hst
+
+ -- Install, or update the remote propellor.
+ updateServer target relay hst
+ (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd])
+ (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd])
+ =<< getprivdata
+
+ -- And now we can run it.
+ unlessM (boolSystemNonConcurrent "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
+ error "remote propellor failed"
+ where
+ hn = fromMaybe target relay
+ sys = case fromInfo (hostInfo hst) of
+ InfoVal o -> Just o
+ NoInfoVal -> Nothing
+
+ relaying = relay == Just target
+ viarelay = isJust relay && not relaying
+
+ probecmd = intercalate " ; "
+ [ "if [ ! -d " ++ localdir ++ "/.git ]"
+ , "then (" ++ intercalate " && "
+ [ installGitCommand sys
+ , "echo " ++ toMarked statusMarker (show NeedGitClone)
+ ] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled)
+ , "else " ++ updatecmd
+ , "fi"
+ ]
+
+ updatecmd = intercalate " && "
+ [ "cd " ++ localdir
+ , bootstrapPropellorCommand sys
+ , if viarelay
+ then "./propellor --continue " ++
+ shellEscape (show (Relay target))
+ -- Still using --boot for back-compat...
+ else "./propellor --boot " ++ target
+ ]
+
+ runcmd = "cd " ++ localdir ++ " && ./propellor " ++ cmd
+ cmd = "--serialized " ++ shellEscape (show cmdline)
+ cmdline
+ | viarelay = Spin [target] (Just target)
+ | otherwise = SimpleRun target
+
+ getprivdata = case mprivdata of
+ Nothing
+ | relaying -> do
+ let f = privDataRelay hn
+ d <- readPrivDataFile f
+ nukeFile f
+ return d
+ | otherwise ->
+ filterPrivData hst <$> decryptPrivData
+ Just pd -> pure pd
+
+-- Check if the Host contains an IP address that matches one of the IPs
+-- in the DNS for the HostName. If so, the HostName is used as-is,
+-- but if the DNS is out of sync with the Host config, or doesn't have
+-- the host in it at all, use one of the Host's IPs instead.
+getSshTarget :: HostName -> Host -> IO String
+getSshTarget target hst
+ | null configips = return target
+ | otherwise = go =<< tryIO (dnslookup target)
+ where
+ go (Left e) = useip (show e)
+ go (Right addrinfos) = do
+ configaddrinfos <- catMaybes <$> mapM iptoaddr configips
+ if any (`elem` configaddrinfos) (map addrAddress addrinfos)
+ then return target
+ else useip ("DNS lookup did not return any of the expected addresses " ++ show configips)
+
+ dnslookup h = getAddrInfo (Just $ defaultHints { addrFlags = [AI_CANONNAME] }) (Just h) Nothing
+
+ -- Convert a string containing an IP address into a SockAddr.
+ iptoaddr :: String -> IO (Maybe SockAddr)
+ iptoaddr ip = catchDefaultIO Nothing $ headMaybe . map addrAddress
+ <$> getAddrInfo (Just $ defaultHints { addrFlags = [AI_NUMERICHOST] }) (Just ip) Nothing
+
+ useip why = case headMaybe configips of
+ Nothing -> return target
+ Just ip -> do
+ -- If we're being asked to run on the local host,
+ -- ignore DNS.
+ s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
+ if s == target
+ then return target
+ else do
+ warningMessage $ "DNS seems out of date for " ++ target ++ " (" ++ why ++ "); using IP address from configuration instead."
+ return ip
+
+ configips = map fromIPAddr $ mapMaybe getIPAddr $
+ S.toList $ fromDnsInfo $ fromInfo $ hostInfo hst
+
+-- Update the privdata, repo url, and git repo over the ssh
+-- connection, talking to the user's local propellor instance which is
+-- running the updateServer
+update :: Maybe HostName -> IO ()
+update forhost = do
+ whenM hasGitRepo $
+ req NeedRepoUrl repoUrlMarker setRepoUrl
+
+ makePrivDataDir
+ createDirectoryIfMissing True (takeDirectory privfile)
+ req NeedPrivData privDataMarker $
+ writeFileProtected privfile
+
+ whenM hasGitRepo $
+ req NeedGitPush gitPushMarker $ \_ -> do
+ hin <- dup stdInput
+ hout <- dup stdOutput
+ hClose stdin
+ hClose stdout
+ -- Not using git pull because git 2.5.0 badly
+ -- broke its option parser.
+ unlessM (boolSystemNonConcurrent "git" (pullparams hin hout)) $
+ errorMessage "git fetch from client failed"
+ unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $
+ errorMessage "git merge from client failed"
+ where
+ pullparams hin hout =
+ [ Param "fetch"
+ , Param "--progress"
+ , Param "--upload-pack"
+ , Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout
+ , Param "."
+ ]
+
+ -- When --spin --relay is run, get a privdata file
+ -- to be relayed to the target host.
+ privfile = maybe privDataLocal privDataRelay forhost
+
+updateServer
+ :: HostName
+ -> Maybe HostName
+ -> Host
+ -> CreateProcess
+ -> CreateProcess
+ -> PrivMap
+ -> IO ()
+updateServer target relay hst connect haveprecompiled privdata = do
+ (Just toh, Just fromh, _, pid) <- createProcessNonConcurrent $ connect
+ { std_in = CreatePipe
+ , std_out = CreatePipe
+ }
+ go (toh, fromh)
+ forceSuccessProcess' connect =<< waitForProcessNonConcurrent pid
+ where
+ hn = fromMaybe target relay
+
+ go (toh, fromh) = do
+ let loop = go (toh, fromh)
+ let restart = updateServer hn relay hst connect haveprecompiled privdata
+ let done = return ()
+ v <- maybe Nothing readish <$> getMarked fromh statusMarker
+ case v of
+ (Just NeedRepoUrl) -> do
+ sendRepoUrl toh
+ loop
+ (Just NeedPrivData) -> do
+ sendPrivData hn toh privdata
+ loop
+ (Just NeedGitClone) -> do
+ hClose toh
+ hClose fromh
+ sendGitClone hn
+ restart
+ (Just NeedPrecompiled) -> do
+ hClose toh
+ hClose fromh
+ sendPrecompiled hn
+ updateServer hn relay hst haveprecompiled (error "loop") privdata
+ (Just NeedGitPush) -> do
+ sendGitUpdate hn fromh toh
+ hClose fromh
+ hClose toh
+ done
+ Nothing -> done
+
+sendRepoUrl :: Handle -> IO ()
+sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
+
+sendPrivData :: HostName -> Handle -> PrivMap -> IO ()
+sendPrivData hn toh privdata = void $ actionMessage msg $ do
+ sendMarked toh privDataMarker d
+ return True
+ where
+ msg = "Sending privdata (" ++ show (length d) ++ " bytes) to " ++ hn
+ d = show privdata
+
+sendGitUpdate :: HostName -> Handle -> Handle -> IO ()
+sendGitUpdate hn fromh toh =
+ void $ actionMessage ("Sending git update to " ++ hn) $ do
+ sendMarked toh gitPushMarker ""
+ (Nothing, Nothing, Nothing, h) <- createProcess p
+ (==) ExitSuccess <$> waitForProcess h
+ where
+ p = (proc "git" ["upload-pack", "."])
+ { std_in = UseHandle fromh
+ , std_out = UseHandle toh
+ }
+
+-- Initial git clone, used for bootstrapping.
+sendGitClone :: HostName -> IO ()
+sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
+ branch <- getCurrentBranch
+ cacheparams <- sshCachingParams hn
+ withTmpFile "propellor.git" $ \tmp _ -> allM id
+ [ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
+ , boolSystemNonConcurrent "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
+ , boolSystemNonConcurrent "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]
+ ]
+ where
+ remotebundle = "/usr/local/propellor.git"
+ unpackcmd branch = shellWrap $ intercalate " && "
+ [ "git clone " ++ remotebundle ++ " " ++ localdir
+ , "cd " ++ localdir
+ , "git checkout -b " ++ branch
+ , "git remote rm origin"
+ , "rm -f " ++ remotebundle
+ ]
+
+-- Send a tarball containing the precompiled propellor, and libraries.
+-- This should be reasonably portable, as long as the remote host has the
+-- same architecture as the build host.
+sendPrecompiled :: HostName -> IO ()
+sendPrecompiled hn = void $ actionMessage "Uploading locally compiled propellor as a last resort" $
+ bracket getWorkingDirectory changeWorkingDirectory $ \_ ->
+ withTmpDir "propellor" go
+ where
+ go tmpdir = do
+ cacheparams <- sshCachingParams hn
+ let shimdir = takeFileName localdir
+ createDirectoryIfMissing True (tmpdir </> shimdir)
+ changeWorkingDirectory (tmpdir </> shimdir)
+ me <- readSymbolicLink "/proc/self/exe"
+ createDirectoryIfMissing True "bin"
+ unlessM (boolSystem "cp" [File me, File "bin/propellor"]) $
+ errorMessage "failed copying in propellor"
+ let bin = "bin/propellor"
+ let binpath = Just $ localdir </> bin
+ void $ Shim.setup bin binpath "."
+ changeWorkingDirectory tmpdir
+ withTmpFile "propellor.tar." $ \tarball _ -> allM id
+ [ boolSystem "strip" [File me]
+ , boolSystem "tar" [Param "czf", File tarball, File shimdir]
+ , boolSystemNonConcurrent "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)]
+ , boolSystemNonConcurrent "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]
+ ]
+
+ remotetarball = "/usr/local/propellor.tar"
+
+ unpackcmd = shellWrap $ intercalate " && "
+ [ "cd " ++ takeDirectory remotetarball
+ , "tar xzf " ++ remotetarball
+ , "rm -f " ++ remotetarball
+ ]
+
+-- Shim for git push over the propellor ssh channel.
+-- Reads from stdin and sends it to hout;
+-- reads from hin and sends it to stdout.
+gitPushHelper :: Fd -> Fd -> IO ()
+gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout
+ where
+ fromstdin = do
+ h <- fdToHandle hout
+ connect stdin h
+ tostdout = do
+ h <- fdToHandle hin
+ connect h stdout
+ connect fromh toh = do
+ hSetBinaryMode fromh True
+ hSetBinaryMode toh True
+ b <- B.hGetSome fromh 40960
+ if B.null b
+ then do
+ hClose fromh
+ hClose toh
+ else do
+ B.hPut toh b
+ hFlush toh
+ connect fromh toh
+
+mergeSpin :: IO ()
+mergeSpin = do
+ branch <- getCurrentBranch
+ branchref <- getCurrentBranchRef
+ old_head <- getCurrentGitSha1 branch
+ old_commit <- findLastNonSpinCommit
+ rungit "reset" [Param old_commit]
+ unlessM (gitCommit Nothing [Param "-a", Param "--allow-empty"]) $
+ error "git commit failed"
+ rungit "merge" =<< gpgSignParams [Param "-s", Param "ours", Param old_head, Param "--no-edit"]
+ current_commit <- getCurrentGitSha1 branch
+ rungit "update-ref" [Param branchref, Param current_commit]
+ rungit "checkout" [Param branch]
+ where
+ rungit cmd ps = unlessM (boolSystem "git" (Param cmd:ps)) $
+ error ("git " ++ cmd ++ " failed")
+
+findLastNonSpinCommit :: IO String
+findLastNonSpinCommit = do
+ commits <- map (separate (== ' ')) . lines
+ <$> readProcess "git" ["log", "--oneline", "--no-abbrev-commit"]
+ case dropWhile (\(_, msg) -> msg == spinCommitMessage) commits of
+ ((sha, _):_) -> return sha
+ _ -> error $ "Did not find any previous commit that was not a " ++ show spinCommitMessage
+
+spinCommitMessage :: String
+spinCommitMessage = "propellor spin"
diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs
new file mode 100644
index 00000000..a7a9452e
--- /dev/null
+++ b/src/Propellor/Ssh.hs
@@ -0,0 +1,79 @@
+module Propellor.Ssh where
+
+import Propellor.Base
+import Utility.UserInfo
+import Utility.FileSystemEncoding
+
+import System.PosixCompat
+import Data.Time.Clock.POSIX
+import qualified Data.Hash.MD5 as MD5
+
+-- Parameters can be passed to both ssh and scp, to enable a ssh connection
+-- caching socket.
+--
+-- If the socket already exists, check if its mtime is older than 10
+-- minutes, and if so stop that ssh process, in order to not try to
+-- use an old stale connection. (atime would be nicer, but there's
+-- a good chance a laptop uses noatime)
+sshCachingParams :: HostName -> IO [CommandParam]
+sshCachingParams hn = do
+ home <- myHomeDir
+ let socketfile = socketFile home hn
+ createDirectoryIfMissing False (takeDirectory socketfile)
+ let ps =
+ [ Param "-o"
+ , Param ("ControlPath=" ++ socketfile)
+ , Param "-o", Param "ControlMaster=auto"
+ , Param "-o", Param "ControlPersist=yes"
+ ]
+
+ maybe noop (expireold ps socketfile)
+ =<< catchMaybeIO (getFileStatus socketfile)
+
+ return ps
+
+ where
+ expireold ps f s = do
+ now <- truncate <$> getPOSIXTime :: IO Integer
+ if modificationTime s > fromIntegral now - tenminutes
+ then touchFile f
+ else do
+ void $ boolSystem "ssh" $
+ [ Param "-O", Param "stop" ] ++ ps ++
+ [ Param "localhost" ]
+ nukeFile f
+ tenminutes = 600
+
+-- Generate a socket filename inside the home directory.
+--
+-- There's a limit in the size of unix domain sockets, of approximately
+-- 100 bytes. Try to never construct a filename longer than that.
+--
+-- When space allows, include the full hostname in the socket filename.
+-- Otherwise, include at least a partial md5sum of it,
+-- to avoid using the same socket file for multiple hosts.
+socketFile :: FilePath -> HostName -> FilePath
+socketFile home hn = selectSocketFile
+ [ sshdir </> hn ++ ".sock"
+ , sshdir </> hn
+ , sshdir </> take 10 hn ++ "-" ++ md5
+ , sshdir </> md5
+ , home </> ".propellor-" ++ md5
+ ]
+ (".propellor-" ++ md5)
+ where
+ sshdir = home </> ".ssh" </> "propellor"
+ md5 = take 9 $ MD5.md5s $ MD5.Str hn
+
+selectSocketFile :: [FilePath] -> FilePath -> FilePath
+selectSocketFile [] d = d
+selectSocketFile [f] _ = f
+selectSocketFile (f:fs) d
+ | valid_unix_socket_path f = f
+ | otherwise = selectSocketFile fs d
+
+valid_unix_socket_path :: FilePath -> Bool
+valid_unix_socket_path f = length (decodeW8 f) < 100 - reservedbyssh
+ where
+ -- ssh tacks on 17 or so characters when making a socket
+ reservedbyssh = 18
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index b606cef2..6d6b14ea 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -1,149 +1,197 @@
-{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-module Propellor.Types
- ( Host(..)
- , Info
- , getInfo
- , Propellor(..)
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Propellor.Types (
+ -- * Core data types
+ Host(..)
, Property(..)
- , RevertableProperty(..)
- , IsProp
- , describe
- , toProp
- , requires
+ , property
, Desc
- , Result(..)
- , ActionResult(..)
- , CmdLine(..)
- , PrivDataField(..)
- , PrivData
- , Context(..)
- , anyContext
- , SshKeyType(..)
+ , RevertableProperty(..)
+ , (<!>)
+ , Propellor(..)
+ , LiftPropellor(..)
+ , Info
+ -- * Types of properties
+ , UnixLike
+ , Linux
+ , DebianLike
+ , Debian
+ , Buntish
+ , FreeBSD
+ , HasInfo
+ , type (+)
+ , TightenTargets(..)
+ -- * Combining and modifying properties
+ , Combines(..)
+ , CombinedType
+ , ResultCombiner
+ , adjustPropertySatisfy
+ -- * Other included types
, module Propellor.Types.OS
, module Propellor.Types.Dns
+ , module Propellor.Types.Result
+ , module Propellor.Types.ZFS
) where
import Data.Monoid
-import Control.Applicative
-import System.Console.ANSI
-import "mtl" Control.Monad.Reader
-import "MonadCatchIO-transformers" Control.Monad.CatchIO
+import Propellor.Types.Core
import Propellor.Types.Info
import Propellor.Types.OS
import Propellor.Types.Dns
-import Propellor.Types.PrivData
-
--- | Everything Propellor knows about a system: Its hostname,
--- properties and other info.
-data Host = Host
- { hostName :: HostName
- , hostProperties :: [Property]
- , hostInfo :: Info
- }
- deriving (Show)
-
--- | Propellor's monad provides read-only access to info about the host
--- it's running on.
-newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p }
- deriving
- ( Monad
- , Functor
- , Applicative
- , MonadReader Host
- , MonadIO
- , MonadCatchIO
- )
+import Propellor.Types.Result
+import Propellor.Types.MetaTypes
+import Propellor.Types.ZFS
-- | The core data type of Propellor, this represents a property
--- that the system should have, and an action to ensure it has the
--- property.
-data Property = Property
- { propertyDesc :: Desc
- , propertySatisfy :: Propellor Result
- -- ^ must be idempotent; may run repeatedly
- , propertyInfo :: Info
- -- ^ a property can add info to the host.
+-- that the system should have, with a descrition, and an action to ensure
+-- it has the property.
+-- that have the property.
+--
+-- There are different types of properties that target different OS's,
+-- and so have different metatypes.
+-- For example: "Property DebianLike" and "Property FreeBSD".
+--
+-- Also, some properties have associated `Info`, which is indicated in
+-- their type: "Property (HasInfo + DebianLike)"
+--
+-- There are many associated type families, which are mostly used
+-- internally, so you needn't worry about them.
+data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
+
+instance Show (Property metatypes) where
+ show p = "property " ++ show (getDesc p)
+
+-- | Constructs a Property, from a description and an action to run to
+-- ensure the Property is met.
+--
+-- Due to the polymorphic return type of this function, most uses will need
+-- to specify a type signature. This lets you specify what OS the property
+-- targets, etc.
+--
+-- For example:
+--
+-- > foo :: Property Debian
+-- > foo = property "foo" $ do
+-- > ...
+-- > return MadeChange
+property
+ :: SingI metatypes
+ => Desc
+ -> Propellor Result
+ -> Property (MetaTypes metatypes)
+property d a = Property sing d a mempty mempty
+
+-- | Changes the action that is performed to satisfy a property.
+adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
+adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
+
+-- | A property that can be reverted. The first Property is run
+-- normally and the second is run when it's reverted.
+data RevertableProperty setupmetatypes undometatypes = RevertableProperty
+ { setupRevertableProperty :: Property setupmetatypes
+ , undoRevertableProperty :: Property undometatypes
}
-instance Show Property where
- show p = "property " ++ show (propertyDesc p)
-
--- | A property that can be reverted.
-data RevertableProperty = RevertableProperty Property Property
-
-class IsProp p where
- -- | Sets description.
- describe :: p -> Desc -> p
- toProp :: p -> Property
- -- | Indicates that the first property can only be satisfied
- -- once the second one is.
- requires :: p -> Property -> p
- getInfo :: p -> Info
-
-instance IsProp Property where
- describe p d = p { propertyDesc = d }
- toProp p = p
- getInfo = propertyInfo
- x `requires` y = Property (propertyDesc x) satisfy info
- where
- info = getInfo y <> getInfo x
- satisfy = do
- r <- propertySatisfy y
- case r of
- FailedChange -> return FailedChange
- _ -> propertySatisfy x
-
-
-instance IsProp RevertableProperty where
+instance Show (RevertableProperty setupmetatypes undometatypes) where
+ show (RevertableProperty p _) = show p
+
+-- | Shorthand to construct a revertable property from any two Properties.
+(<!>)
+ :: Property setupmetatypes
+ -> Property undometatypes
+ -> RevertableProperty setupmetatypes undometatypes
+setup <!> undo = RevertableProperty setup undo
+
+instance IsProp (Property metatypes) where
+ setDesc (Property t _ a i c) d = Property t d a i c
+ getDesc (Property _ d _ _ _) = d
+ getChildren (Property _ _ _ _ c) = c
+ addChildren (Property t d a i c) c' = Property t d a i (c ++ c')
+ getInfoRecursive (Property _ _ _ i c) =
+ i <> mconcat (map getInfoRecursive c)
+ getInfo (Property _ _ _ i _) = i
+ toChildProperty (Property _ d a i c) = ChildProperty d a i c
+ getSatisfy (Property _ _ a _ _) = a
+
+instance IsProp (RevertableProperty setupmetatypes undometatypes) where
-- | Sets the description of both sides.
- describe (RevertableProperty p1 p2) d =
- RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
- toProp (RevertableProperty p1 _) = p1
- (RevertableProperty p1 p2) `requires` y =
- RevertableProperty (p1 `requires` y) p2
+ setDesc (RevertableProperty p1 p2) d =
+ RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
+ getDesc (RevertableProperty p1 _) = getDesc p1
+ getChildren (RevertableProperty p1 _) = getChildren p1
+ -- | Only add children to the active side.
+ addChildren (RevertableProperty p1 p2) c = RevertableProperty (addChildren p1 c) p2
-- | Return the Info of the currently active side.
+ getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
getInfo (RevertableProperty p1 _p2) = getInfo p1
-
-type Desc = String
-
-data Result = NoChange | MadeChange | FailedChange
- deriving (Read, Show, Eq)
-
-instance Monoid Result where
- mempty = NoChange
-
- mappend FailedChange _ = FailedChange
- mappend _ FailedChange = FailedChange
- mappend MadeChange _ = MadeChange
- mappend _ MadeChange = MadeChange
- mappend NoChange NoChange = NoChange
-
--- | Results of actions, with color.
-class ActionResult a where
- getActionResult :: a -> (String, ColorIntensity, Color)
-
-instance ActionResult Bool where
- getActionResult False = ("failed", Vivid, Red)
- getActionResult True = ("done", Dull, Green)
-
-instance ActionResult Result where
- getActionResult NoChange = ("ok", Dull, Green)
- getActionResult MadeChange = ("done", Vivid, Green)
- getActionResult FailedChange = ("failed", Vivid, Red)
-
-data CmdLine
- = Run HostName
- | Spin HostName
- | Boot HostName
- | Set PrivDataField Context
- | Dump PrivDataField Context
- | Edit PrivDataField Context
- | ListFields
- | AddKey String
- | Continue CmdLine
- | Chain HostName
- | Docker HostName
- deriving (Read, Show, Eq)
+ toChildProperty (RevertableProperty p1 _p2) = toChildProperty p1
+ getSatisfy (RevertableProperty p1 _) = getSatisfy p1
+
+-- | Type level calculation of the type that results from combining two
+-- types of properties.
+type family CombinedType x y
+type instance CombinedType (Property (MetaTypes x)) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y))
+type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) = RevertableProperty (MetaTypes (Combine x y)) (MetaTypes (Combine x' y'))
+-- When only one of the properties is revertable, the combined property is
+-- not fully revertable, so is not a RevertableProperty.
+type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y))
+type instance CombinedType (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) = Property (MetaTypes (Combine x y))
+
+type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result
+
+class Combines x y where
+ -- | Combines together two properties, yielding a property that
+ -- has the description and info of the first, and that has the
+ -- second property as a child property.
+ combineWith
+ :: ResultCombiner
+ -- ^ How to combine the actions to satisfy the properties.
+ -> ResultCombiner
+ -- ^ Used when combining revertable properties, to combine
+ -- their reversion actions.
+ -> x
+ -> y
+ -> CombinedType x y
+
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where
+ combineWith f _ (Property _ d1 a1 i1 c1) (Property _ d2 a2 i2 c2) =
+ Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1)
+instance (CheckCombinable x y ~ 'CanCombine, CheckCombinable x' y' ~ 'CanCombine, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+ combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
+ RevertableProperty
+ (combineWith sf tf s1 s2)
+ (combineWith tf sf t1 t2)
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where
+ combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+ combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y
+
+class TightenTargets p where
+ -- | Tightens the MetaType list of a Property (or similar),
+ -- to contain fewer targets.
+ --
+ -- For example, to make a property that uses apt-get, which is only
+ -- available on DebianLike systems:
+ --
+ -- > upgraded :: Property DebianLike
+ -- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]
+ tightenTargets
+ ::
+ -- Note that this uses PolyKinds
+ ( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine
+ , (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine
+ , SingI tightened
+ )
+ => p (MetaTypes untightened)
+ -> p (MetaTypes tightened)
+
+instance TightenTargets Property where
+ tightenTargets (Property _ d a i c) = Property sing d a i c
diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs
new file mode 100644
index 00000000..fc049603
--- /dev/null
+++ b/src/Propellor/Types/Chroot.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Propellor.Types.Chroot where
+
+import Propellor.Types
+import Propellor.Types.Empty
+import Propellor.Types.Info
+
+import Data.Monoid
+import qualified Data.Map as M
+
+data ChrootInfo = ChrootInfo
+ { _chroots :: M.Map FilePath Host
+ , _chrootCfg :: ChrootCfg
+ }
+ deriving (Show, Typeable)
+
+instance IsInfo ChrootInfo where
+ propagateInfo _ = False
+
+instance Monoid ChrootInfo where
+ mempty = ChrootInfo mempty mempty
+ mappend old new = ChrootInfo
+ { _chroots = M.union (_chroots old) (_chroots new)
+ , _chrootCfg = _chrootCfg old <> _chrootCfg new
+ }
+
+instance Empty ChrootInfo where
+ isEmpty i = and
+ [ isEmpty (_chroots i)
+ , isEmpty (_chrootCfg i)
+ ]
+
+data ChrootCfg
+ = NoChrootCfg
+ | SystemdNspawnCfg [(String, Bool)]
+ deriving (Show, Eq)
+
+instance Monoid ChrootCfg where
+ mempty = NoChrootCfg
+ mappend v NoChrootCfg = v
+ mappend NoChrootCfg v = v
+ mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) =
+ SystemdNspawnCfg (l1 <> l2)
+
+instance Empty ChrootCfg where
+ isEmpty c= c == NoChrootCfg
diff --git a/src/Propellor/Types/CmdLine.hs b/src/Propellor/Types/CmdLine.hs
new file mode 100644
index 00000000..558c6e8b
--- /dev/null
+++ b/src/Propellor/Types/CmdLine.hs
@@ -0,0 +1,31 @@
+module Propellor.Types.CmdLine where
+
+import Propellor.Types.OS
+import Propellor.Types.PrivData
+
+import System.Posix.Types
+
+-- | All the command line actions that propellor can perform.
+data CmdLine
+ = Run HostName
+ | Spin [HostName] (Maybe HostName)
+ | SimpleRun HostName
+ | Set PrivDataField Context
+ | Unset PrivDataField Context
+ | UnsetUnused
+ | Dump PrivDataField Context
+ | Edit PrivDataField Context
+ | ListFields
+ | AddKey String
+ | RmKey String
+ | Merge
+ | Serialized CmdLine
+ | Continue CmdLine
+ | Update (Maybe HostName)
+ | Relay HostName
+ | DockerInit HostName
+ | DockerChain HostName String
+ | ChrootChain HostName FilePath Bool Bool
+ | GitPush Fd Fd
+ | Check
+ deriving (Read, Show, Eq)
diff --git a/src/Propellor/Types/Container.hs b/src/Propellor/Types/Container.hs
new file mode 100644
index 00000000..217d7df7
--- /dev/null
+++ b/src/Propellor/Types/Container.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Propellor.Types.Container where
+
+-- | A value that can be bound between the host and a container.
+--
+-- For example, a Bound Port is a Port on the container that is bound to
+-- a Port on the host.
+data Bound v = Bound
+ { hostSide :: v
+ , containerSide :: v
+ }
+
+-- | Create a Bound value, from two different values for the host and
+-- container.
+--
+-- For example, @Port 8080 -<- Port 80@ means that port 8080 on the host
+-- is bound to port 80 from the container.
+(-<-) :: (hostv ~ v, containerv ~ v) => hostv -> containerv -> Bound v
+(-<-) = Bound
+
+-- | Flipped version of -<- with the container value first and host value
+-- second.
+(->-) :: (containerv ~ v, hostv ~ v) => containerv -> hostv -> Bound v
+(->-) = flip (-<-)
+
+-- | Create a Bound value, that is the same on both the host and container.
+same :: v -> Bound v
+same v = Bound v v
+
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
new file mode 100644
index 00000000..6fedc47e
--- /dev/null
+++ b/src/Propellor/Types/Core.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Types.Core where
+
+import Propellor.Types.Info
+import Propellor.Types.OS
+import Propellor.Types.Result
+
+import Data.Monoid
+import "mtl" Control.Monad.RWS.Strict
+import Control.Monad.Catch
+import Control.Applicative
+import Prelude
+
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and their collected info.
+data Host = Host
+ { hostName :: HostName
+ , hostProperties :: [ChildProperty]
+ , hostInfo :: Info
+ }
+ deriving (Show, Typeable)
+
+-- | Propellor's monad provides read-only access to info about the host
+-- it's running on, and a writer to accumulate EndActions.
+newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
+ deriving
+ ( Monad
+ , Functor
+ , Applicative
+ , MonadReader Host
+ , MonadWriter [EndAction]
+ , MonadIO
+ , MonadCatch
+ , MonadThrow
+ , MonadMask
+ )
+
+class LiftPropellor m where
+ liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+ liftPropellor = id
+
+instance LiftPropellor IO where
+ liftPropellor = liftIO
+
+instance Monoid (Propellor Result) where
+ mempty = return NoChange
+ -- | The second action is only run if the first action does not fail.
+ mappend x y = do
+ rx <- x
+ case rx of
+ FailedChange -> return FailedChange
+ _ -> do
+ ry <- y
+ return (rx <> ry)
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties. It's passed the combined Result of the entire Propellor run.
+data EndAction = EndAction Desc (Result -> Propellor Result)
+
+type Desc = String
+
+-- | Props is a combination of a list of properties, with their combined
+-- metatypes.
+data Props metatypes = Props [ChildProperty]
+
+-- | Since there are many different types of Properties, they cannot be put
+-- into a list. The simplified ChildProperty can be put into a list.
+data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
+
+instance Show ChildProperty where
+ show p = "property " ++ show (getDesc p)
+
+class IsProp p where
+ setDesc :: p -> Desc -> p
+ getDesc :: p -> Desc
+ getChildren :: p -> [ChildProperty]
+ addChildren :: p -> [ChildProperty] -> p
+ -- | Gets the info of the property, combined with all info
+ -- of all children properties.
+ getInfoRecursive :: p -> Info
+ -- | Info, not including info from children.
+ getInfo :: p -> Info
+ -- | Gets a ChildProperty representing the Property.
+ -- You should not normally need to use this.
+ toChildProperty :: p -> ChildProperty
+ -- | Gets the action that can be run to satisfy a Property.
+ -- You should never run this action directly. Use
+ -- 'Propellor.EnsureProperty.ensureProperty` instead.
+ getSatisfy :: p -> Propellor Result
+
+instance IsProp ChildProperty where
+ setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
+ getDesc (ChildProperty d _ _ _) = d
+ getChildren (ChildProperty _ _ _ c) = c
+ addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
+ getInfoRecursive (ChildProperty _ _ i c) =
+ i <> mconcat (map getInfoRecursive c)
+ getInfo (ChildProperty _ _ i _) = i
+ toChildProperty = id
+ getSatisfy (ChildProperty _ a _ _) = a
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index 66fbd1a4..8f15d156 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -1,10 +1,18 @@
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+
module Propellor.Types.Dns where
import Propellor.Types.OS (HostName)
+import Propellor.Types.Empty
+import Propellor.Types.Info
import Data.Word
-import Data.Monoid
import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.List
+import Data.String.Utils (split, replace)
+import Data.Monoid
+import Prelude
type Domain = String
@@ -15,6 +23,29 @@ fromIPAddr :: IPAddr -> String
fromIPAddr (IPv4 addr) = addr
fromIPAddr (IPv6 addr) = addr
+newtype AliasesInfo = AliasesInfo (S.Set HostName)
+ deriving (Show, Eq, Ord, Monoid, Typeable)
+
+instance IsInfo AliasesInfo where
+ propagateInfo _ = False
+
+toAliasesInfo :: [HostName] -> AliasesInfo
+toAliasesInfo l = AliasesInfo (S.fromList l)
+
+fromAliasesInfo :: AliasesInfo -> [HostName]
+fromAliasesInfo (AliasesInfo s) = S.toList s
+
+newtype DnsInfo = DnsInfo { fromDnsInfo :: S.Set Record }
+ deriving (Show, Eq, Ord, Monoid, Typeable)
+
+toDnsInfo :: S.Set Record -> DnsInfo
+toDnsInfo = DnsInfo
+
+-- | DNS Info is propagated, so that eg, aliases of a container
+-- are reflected in the dns for the host where it runs.
+instance IsInfo DnsInfo where
+ propagateInfo _ = True
+
-- | Represents a bind 9 named.conf file.
data NamedConf = NamedConf
{ confDomain :: Domain
@@ -61,7 +92,35 @@ data Record
| NS BindDomain
| TXT String
| SRV Word16 Word16 Word16 BindDomain
- deriving (Read, Show, Eq, Ord)
+ | SSHFP Int Int String
+ | INCLUDE FilePath
+ | PTR ReverseIP
+ deriving (Read, Show, Eq, Ord, Typeable)
+
+-- | An in-addr.arpa record corresponding to an IPAddr.
+type ReverseIP = String
+
+reverseIP :: IPAddr -> ReverseIP
+reverseIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"
+reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonicalIP addr) ++ ".ip6.arpa"
+
+-- | Converts an IP address (particularly IPv6) to canonical, fully
+-- expanded form.
+canonicalIP :: IPAddr -> IPAddr
+canonicalIP (IPv4 addr) = IPv4 addr
+canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr
+ where
+ canonicalGroup g
+ | l <= 4 = replicate (4 - l) '0' ++ g
+ | otherwise = error $ "IPv6 group " ++ g ++ "as more than 4 hex digits"
+ where
+ l = length g
+ emptyGroups n = iterate (++ ":") "" !! n
+ numberOfImplicitGroups a = 8 - length (split ":" $ replace "::" "" a)
+ replaceImplicitGroups a = concat $ aux $ split "::" a
+ where
+ aux [] = []
+ aux (x : xs) = x : emptyGroups (numberOfImplicitGroups a) : xs
getIPAddr :: Record -> Maybe IPAddr
getIPAddr (Address addr) = Just addr
@@ -94,7 +153,10 @@ domainHostName (AbsDomain d) = Just d
domainHostName RootDomain = Nothing
newtype NamedConfMap = NamedConfMap (M.Map Domain NamedConf)
- deriving (Eq, Ord, Show)
+ deriving (Eq, Ord, Show, Typeable)
+
+instance IsInfo NamedConfMap where
+ propagateInfo _ = False
-- | Adding a Master NamedConf stanza for a particulr domain always
-- overrides an existing Secondary stanza for that domain, while a
@@ -108,5 +170,8 @@ instance Monoid NamedConfMap where
(Secondary, Master) -> o
_ -> n
+instance Empty NamedConfMap where
+ isEmpty (NamedConfMap m) = isEmpty m
+
fromNamedConfMap :: NamedConfMap -> M.Map Domain NamedConf
fromNamedConfMap (NamedConfMap m) = m
diff --git a/src/Propellor/Types/Docker.hs b/src/Propellor/Types/Docker.hs
new file mode 100644
index 00000000..f3cc4a52
--- /dev/null
+++ b/src/Propellor/Types/Docker.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Propellor.Types.Docker where
+
+import Propellor.Types
+import Propellor.Types.Empty
+import Propellor.Types.Info
+
+import Data.Monoid
+import qualified Data.Map as M
+
+data DockerInfo = DockerInfo
+ { _dockerRunParams :: [DockerRunParam]
+ , _dockerContainers :: M.Map String Host
+ }
+ deriving (Show, Typeable)
+
+instance IsInfo DockerInfo where
+ propagateInfo _ = False
+
+instance Monoid DockerInfo where
+ mempty = DockerInfo mempty mempty
+ mappend old new = DockerInfo
+ { _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+ , _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new)
+ }
+
+instance Empty DockerInfo where
+ isEmpty i = and
+ [ isEmpty (_dockerRunParams i)
+ , isEmpty (_dockerContainers i)
+ ]
+
+newtype DockerRunParam = DockerRunParam (HostName -> String)
+
+instance Show DockerRunParam where
+ show (DockerRunParam a) = a ""
diff --git a/src/Propellor/Types/Empty.hs b/src/Propellor/Types/Empty.hs
new file mode 100644
index 00000000..dcd2f4a0
--- /dev/null
+++ b/src/Propellor/Types/Empty.hs
@@ -0,0 +1,16 @@
+module Propellor.Types.Empty where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+class Empty t where
+ isEmpty :: t -> Bool
+
+instance Empty [a] where
+ isEmpty = null
+
+instance Empty (M.Map k v) where
+ isEmpty = M.null
+
+instance Empty (S.Set v) where
+ isEmpty = S.null
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index de072aa0..2e188ae5 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -1,70 +1,92 @@
-module Propellor.Types.Info where
+{-# LANGUAGE GADTs, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-import Propellor.Types.OS
-import Propellor.Types.PrivData
-import qualified Propellor.Types.Dns as Dns
+module Propellor.Types.Info (
+ Info,
+ IsInfo(..),
+ addInfo,
+ toInfo,
+ fromInfo,
+ mapInfo,
+ propagatableInfo,
+ InfoVal(..),
+ fromInfoVal,
+ Typeable,
+) where
-import qualified Data.Set as S
+import Data.Dynamic
+import Data.Maybe
import Data.Monoid
+import Prelude
--- | Information about a host.
-data Info = Info
- { _os :: Val System
- , _privDataFields :: S.Set (PrivDataField, Context)
- , _sshPubKey :: Val String
- , _aliases :: S.Set HostName
- , _dns :: S.Set Dns.Record
- , _namedconf :: Dns.NamedConfMap
- , _dockerinfo :: DockerInfo
- }
- deriving (Eq, Show)
-
-instance Monoid Info where
- mempty = Info mempty mempty mempty mempty mempty mempty mempty
- mappend old new = Info
- { _os = _os old <> _os new
- , _privDataFields = _privDataFields old <> _privDataFields new
- , _sshPubKey = _sshPubKey old <> _sshPubKey new
- , _aliases = _aliases old <> _aliases new
- , _dns = _dns old <> _dns new
- , _namedconf = _namedconf old <> _namedconf new
- , _dockerinfo = _dockerinfo old <> _dockerinfo new
- }
-
-data Val a = Val a | NoVal
- deriving (Eq, Show)
-
-instance Monoid (Val a) where
- mempty = NoVal
- mappend old new = case new of
- NoVal -> old
- _ -> new
-
-fromVal :: Val a -> Maybe a
-fromVal (Val a) = Just a
-fromVal NoVal = Nothing
-
-data DockerInfo = DockerInfo
- { _dockerImage :: Val String
- , _dockerRunParams :: [HostName -> String]
- }
-
-instance Eq DockerInfo where
- x == y = and
- [ _dockerImage x == _dockerImage y
- , let simpl v = map (\a -> a "") (_dockerRunParams v)
- in simpl x == simpl y
- ]
-
-instance Monoid DockerInfo where
- mempty = DockerInfo mempty mempty
- mappend old new = DockerInfo
- { _dockerImage = _dockerImage old <> _dockerImage new
- , _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
- }
-
-instance Show DockerInfo where
- show a = unlines
- [ "docker image " ++ show (_dockerImage a)
- , "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
- ]
+-- | Information about a Host, which can be provided by its properties.
+--
+-- Many different types of data can be contained in the same Info value
+-- at the same time. See `toInfo` and `fromInfo`.
+newtype Info = Info [InfoEntry]
+ deriving (Monoid, Show)
+
+data InfoEntry where
+ InfoEntry :: (IsInfo v, Typeable v) => v -> InfoEntry
+
+instance Show InfoEntry where
+ show (InfoEntry v) = show v
+
+-- Extracts the value from an InfoEntry but only when
+-- it's of the requested type.
+extractInfoEntry :: Typeable v => InfoEntry -> Maybe v
+extractInfoEntry (InfoEntry v) = cast v
+
+-- | Values stored in Info must be members of this class.
+--
+-- This is used to avoid accidentially using other data types
+-- as info, especially type aliases which coud easily lead to bugs.
+-- We want a little bit of dynamic types here, but not too far..
+class (Typeable v, Monoid v, Show v) => IsInfo v where
+ -- | Should info of this type be propagated out of a
+ -- container to its Host?
+ propagateInfo :: v -> Bool
+
+-- | Any value in the `IsInfo` type class can be added to an Info.
+addInfo :: IsInfo v => Info -> v -> Info
+addInfo (Info l) v = Info (InfoEntry v:l)
+
+-- | Converts any value in the `IsInfo` type class into an Info,
+-- which is otherwise empty.
+toInfo :: IsInfo v => v -> Info
+toInfo = addInfo mempty
+
+-- The list is reversed here because addInfo builds it up in reverse order.
+fromInfo :: IsInfo v => Info -> v
+fromInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l))
+
+-- | Maps a function over all values stored in the Info that are of the
+-- appropriate type.
+mapInfo :: IsInfo v => (v -> v) -> Info -> Info
+mapInfo f (Info l) = Info (map go l)
+ where
+ go i = case extractInfoEntry i of
+ Nothing -> i
+ Just v -> InfoEntry (f v)
+
+-- | Filters out parts of the Info that should not propagate out of a
+-- container.
+propagatableInfo :: Info -> Info
+propagatableInfo (Info l) = Info (filter (\(InfoEntry a) -> propagateInfo a) l)
+
+-- | Use this to put a value in Info that is not a monoid.
+-- The last value set will be used. This info does not propagate
+-- out of a container.
+data InfoVal v = NoInfoVal | InfoVal v
+ deriving (Typeable, Show)
+
+instance Monoid (InfoVal v) where
+ mempty = NoInfoVal
+ mappend _ v@(InfoVal _) = v
+ mappend v NoInfoVal = v
+
+instance (Typeable v, Show v) => IsInfo (InfoVal v) where
+ propagateInfo _ = False
+
+fromInfoVal :: InfoVal v -> Maybe v
+fromInfoVal NoInfoVal = Nothing
+fromInfoVal (InfoVal v) = Just v
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
new file mode 100644
index 00000000..e064d76f
--- /dev/null
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -0,0 +1,213 @@
+{-# LANGUAGE TypeOperators, PolyKinds, DataKinds, TypeFamilies, UndecidableInstances, FlexibleInstances, GADTs #-}
+
+module Propellor.Types.MetaTypes (
+ MetaType(..),
+ UnixLike,
+ Linux,
+ DebianLike,
+ Debian,
+ Buntish,
+ FreeBSD,
+ HasInfo,
+ MetaTypes,
+ type (+),
+ sing,
+ SingI,
+ IncludesInfo,
+ Targets,
+ NonTargets,
+ NotSuperset,
+ Combine,
+ CheckCombine(..),
+ CheckCombinable,
+ type (&&),
+ Not,
+ EqT,
+ Union,
+) where
+
+import Propellor.Types.Singletons
+import Propellor.Types.OS
+
+data MetaType
+ = Targeting TargetOS -- ^ A target OS of a Property
+ | WithInfo -- ^ Indicates that a Property has associated Info
+ deriving (Show, Eq, Ord)
+
+-- | Any unix-like system
+type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ]
+-- | Any linux system
+type Linux = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
+-- | Debian and derivatives.
+type DebianLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
+type Debian = MetaTypes '[ 'Targeting 'OSDebian ]
+type Buntish = MetaTypes '[ 'Targeting 'OSBuntish ]
+type FreeBSD = MetaTypes '[ 'Targeting 'OSFreeBSD ]
+
+-- | Used to indicate that a Property adds Info to the Host where it's used.
+type HasInfo = MetaTypes '[ 'WithInfo ]
+
+type family IncludesInfo t :: Bool
+type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l
+
+type MetaTypes = Sing
+
+-- This boilerplate would not be needed if the singletons library were
+-- used. However, we're targeting too old a version of ghc to use it yet.
+data instance Sing (x :: MetaType) where
+ OSDebianS :: Sing ('Targeting 'OSDebian)
+ OSBuntishS :: Sing ('Targeting 'OSBuntish)
+ OSFreeBSDS :: Sing ('Targeting 'OSFreeBSD)
+ WithInfoS :: Sing 'WithInfo
+instance SingI ('Targeting 'OSDebian) where sing = OSDebianS
+instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS
+instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS
+instance SingI 'WithInfo where sing = WithInfoS
+instance SingKind ('KProxy :: KProxy MetaType) where
+ type DemoteRep ('KProxy :: KProxy MetaType) = MetaType
+ fromSing OSDebianS = Targeting OSDebian
+ fromSing OSBuntishS = Targeting OSBuntish
+ fromSing OSFreeBSDS = Targeting OSFreeBSD
+ fromSing WithInfoS = WithInfo
+
+-- | Convenience type operator to combine two `MetaTypes` lists.
+--
+-- For example:
+--
+-- > HasInfo + Debian
+--
+-- Which is shorthand for this type:
+--
+-- > MetaTypes '[WithInfo, Targeting OSDebian]
+type family a + b :: ab
+type instance (MetaTypes a) + (MetaTypes b) = MetaTypes (Concat a b)
+
+type family Concat (list1 :: [a]) (list2 :: [a]) :: [a]
+type instance Concat '[] bs = bs
+type instance Concat (a ': as) bs = a ': (Concat as bs)
+
+-- | Combine two MetaTypes lists, yielding a list
+-- that has targets present in both, and nontargets present in either.
+type family Combine (list1 :: [a]) (list2 :: [a]) :: [a]
+type instance Combine (list1 :: [a]) (list2 :: [a]) =
+ (Concat
+ (NonTargets list1 `Union` NonTargets list2)
+ (Targets list1 `Intersect` Targets list2)
+ )
+
+-- | Checks if two MetaTypes lists can be safely combined.
+--
+-- This should be used anywhere Combine is used, as an additional
+-- constraint. For example:
+--
+-- > foo :: (CheckCombinable x y ~ 'CanCombine) => x -> y -> Combine x y
+type family CheckCombinable (list1 :: [a]) (list2 :: [a]) :: CheckCombine
+-- As a special case, if either list is empty, let it be combined with the
+-- other. This relies on MetaTypes list always containing at least
+-- one target, so can only happen if there's already been a type error.
+-- This special case lets the type checker show only the original type
+-- error, and not an extra error due to a later CheckCombinable constraint.
+type instance CheckCombinable '[] list2 = 'CanCombine
+type instance CheckCombinable list1 '[] = 'CanCombine
+type instance CheckCombinable (l1 ': list1) (l2 ': list2) =
+ CheckCombinable' (Combine (l1 ': list1) (l2 ': list2))
+type family CheckCombinable' (combinedlist :: [a]) :: CheckCombine
+type instance CheckCombinable' '[] = 'CannotCombineTargets
+type instance CheckCombinable' (a ': rest)
+ = If (IsTarget a)
+ 'CanCombine
+ (CheckCombinable' rest)
+
+data CheckCombine = CannotCombineTargets | CanCombine
+
+-- | Every item in the subset must be in the superset.
+--
+-- The name of this was chosen to make type errors more understandable.
+type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombine
+type instance NotSuperset superset '[] = 'CanCombine
+type instance NotSuperset superset (s ': rest) =
+ If (Elem s superset)
+ (NotSuperset superset rest)
+ 'CannotCombineTargets
+
+type family IsTarget (a :: t) :: Bool
+type instance IsTarget ('Targeting a) = 'True
+type instance IsTarget 'WithInfo = 'False
+
+type family Targets (l :: [a]) :: [a]
+type instance Targets '[] = '[]
+type instance Targets (x ': xs) =
+ If (IsTarget x)
+ (x ': Targets xs)
+ (Targets xs)
+
+type family NonTargets (l :: [a]) :: [a]
+type instance NonTargets '[] = '[]
+type instance NonTargets (x ': xs) =
+ If (IsTarget x)
+ (NonTargets xs)
+ (x ': NonTargets xs)
+
+-- | Type level elem
+type family Elem (a :: t) (list :: [t]) :: Bool
+type instance Elem a '[] = 'False
+type instance Elem a (b ': bs) = EqT a b || Elem a bs
+
+-- | Type level union.
+type family Union (list1 :: [a]) (list2 :: [a]) :: [a]
+type instance Union '[] list2 = list2
+type instance Union (a ': rest) list2 =
+ If (Elem a list2 || Elem a rest)
+ (Union rest list2)
+ (a ': Union rest list2)
+
+-- | Type level intersection. Duplicate list items are eliminated.
+type family Intersect (list1 :: [a]) (list2 :: [a]) :: [a]
+type instance Intersect '[] list2 = '[]
+type instance Intersect (a ': rest) list2 =
+ If (Elem a list2 && Not (Elem a rest))
+ (a ': Intersect rest list2)
+ (Intersect rest list2)
+
+-- | Type level equality
+--
+-- This is a very clumsy implmentation, but it works back to ghc 7.6.
+type family EqT (a :: t) (b :: t) :: Bool
+type instance EqT ('Targeting a) ('Targeting b) = EqT a b
+type instance EqT 'WithInfo 'WithInfo = 'True
+type instance EqT 'WithInfo ('Targeting b) = 'False
+type instance EqT ('Targeting a) 'WithInfo = 'False
+type instance EqT 'OSDebian 'OSDebian = 'True
+type instance EqT 'OSBuntish 'OSBuntish = 'True
+type instance EqT 'OSFreeBSD 'OSFreeBSD = 'True
+type instance EqT 'OSDebian 'OSBuntish = 'False
+type instance EqT 'OSDebian 'OSFreeBSD = 'False
+type instance EqT 'OSBuntish 'OSDebian = 'False
+type instance EqT 'OSBuntish 'OSFreeBSD = 'False
+type instance EqT 'OSFreeBSD 'OSDebian = 'False
+type instance EqT 'OSFreeBSD 'OSBuntish = 'False
+-- More modern version if the combinatiorial explosion gets too bad later:
+--
+-- type family Eq (a :: MetaType) (b :: MetaType) where
+-- Eq a a = True
+-- Eq a b = False
+
+-- | An equivilant to the following is in Data.Type.Bool in
+-- modern versions of ghc, but is included here to support ghc 7.6.
+type family If (cond :: Bool) (tru :: a) (fls :: a) :: a
+type instance If 'True tru fls = tru
+type instance If 'False tru fls = fls
+type family (a :: Bool) || (b :: Bool) :: Bool
+type instance 'False || 'False = 'False
+type instance 'True || 'True = 'True
+type instance 'True || 'False = 'True
+type instance 'False || 'True = 'True
+type family (a :: Bool) && (b :: Bool) :: Bool
+type instance 'False && 'False = 'False
+type instance 'True && 'True = 'True
+type instance 'True && 'False = 'False
+type instance 'False && 'True = 'False
+type family Not (a :: Bool) :: Bool
+type instance Not 'False = 'True
+type instance Not 'True = 'False
+
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 2529e7d8..d7df5490 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -1,26 +1,96 @@
-module Propellor.Types.OS where
+{-# LANGUAGE DeriveDataTypeable #-}
-type HostName = String
-type UserName = String
-type GroupName = String
+module Propellor.Types.OS (
+ System(..),
+ Distribution(..),
+ TargetOS(..),
+ DebianSuite(..),
+ FreeBSDRelease(..),
+ FBSDVersion(..),
+ isStable,
+ Release,
+ Architecture,
+ HostName,
+ UserName,
+ User(..),
+ Group(..),
+ userGroup,
+ Port(..),
+ fromPort,
+ systemToTargetOS,
+) where
+
+import Network.BSD (HostName)
+import Data.Typeable
+import Data.String
--- | High level descritption of a operating system.
+-- | High level description of a operating system.
data System = System Distribution Architecture
- deriving (Show, Eq)
+ deriving (Show, Eq, Typeable)
data Distribution
= Debian DebianSuite
- | Ubuntu Release
+ | Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>
+ | FreeBSD FreeBSDRelease
deriving (Show, Eq)
+-- | Properties can target one or more OS's; the targets are part
+-- of the type of the property, so need to be kept fairly simple.
+data TargetOS
+ = OSDebian
+ | OSBuntish
+ | OSFreeBSD
+ deriving (Show, Eq, Ord)
+
+systemToTargetOS :: System -> TargetOS
+systemToTargetOS (System (Debian _) _) = OSDebian
+systemToTargetOS (System (Buntish _) _) = OSBuntish
+systemToTargetOS (System (FreeBSD _) _) = OSFreeBSD
+
-- | Debian has several rolling suites, and a number of stable releases,
--- such as Stable "wheezy".
+-- such as Stable "jessie".
data DebianSuite = Experimental | Unstable | Testing | Stable Release
deriving (Show, Eq)
+-- | FreeBSD breaks their releases into "Production" and "Legacy".
+data FreeBSDRelease = FBSDProduction FBSDVersion | FBSDLegacy FBSDVersion
+ deriving (Show, Eq)
+
+data FBSDVersion = FBSD101 | FBSD102 | FBSD093
+ deriving (Eq)
+
+instance IsString FBSDVersion where
+ fromString "10.1-RELEASE" = FBSD101
+ fromString "10.2-RELEASE" = FBSD102
+ fromString "9.3-RELEASE" = FBSD093
+ fromString _ = error "Invalid FreeBSD release"
+
+instance Show FBSDVersion where
+ show FBSD101 = "10.1-RELEASE"
+ show FBSD102 = "10.2-RELEASE"
+ show FBSD093 = "9.3-RELEASE"
+
isStable :: DebianSuite -> Bool
isStable (Stable _) = True
isStable _ = False
type Release = String
type Architecture = String
+
+type UserName = String
+
+newtype User = User UserName
+ deriving (Eq, Ord, Show)
+
+newtype Group = Group String
+ deriving (Eq, Ord, Show)
+
+-- | Makes a Group with the same name as the User.
+userGroup :: User -> Group
+userGroup (User u) = Group u
+
+newtype Port = Port Int
+ deriving (Eq, Show)
+
+fromPort :: Port -> String
+fromPort (Port p) = show p
diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs
index 16d6cdb1..32b51c4b 100644
--- a/src/Propellor/Types/PrivData.hs
+++ b/src/Propellor/Types/PrivData.hs
@@ -1,34 +1,134 @@
module Propellor.Types.PrivData where
import Propellor.Types.OS
+import Utility.PartialPrelude
+import Utility.FileSystemEncoding
--- | Note that removing or changing field names will break the
--- serialized privdata files, so don't do that!
--- It's fine to add new fields.
+import Data.Maybe
+import qualified Data.ByteString.Lazy as L
+
+-- | Note that removing or changing constructors or changing types will
+-- break the serialized privdata files, so don't do that!
+-- It's fine to add new constructors.
data PrivDataField
= DockerAuthentication
- | SshPubKey SshKeyType UserName
- | SshPrivKey SshKeyType UserName
+ | SshPubKey SshKeyType UserName -- ^ Not used anymore, but retained to avoid breaking serialization of old files
+ | SshPrivKey SshKeyType UserName -- ^ For host key, use empty UserName
| SshAuthorizedKeys UserName
| Password UserName
+ | CryptPassword UserName
| PrivFile FilePath
| GpgKey
+ | DnsSec DnsSecKey
deriving (Read, Show, Ord, Eq)
--- | Context in which a PrivDataField is used.
+-- | Combines a PrivDataField with a description of how to generate
+-- its value.
+data PrivDataSource
+ = PrivDataSourceFile PrivDataField FilePath
+ | PrivDataSourceFileFromCommand PrivDataField FilePath String
+ | PrivDataSource PrivDataField String
+
+type PrivDataSourceDesc = String
+
+class IsPrivDataSource s where
+ privDataField :: s -> PrivDataField
+ describePrivDataSource :: s -> Maybe PrivDataSourceDesc
+
+instance IsPrivDataSource PrivDataField where
+ privDataField = id
+ describePrivDataSource _ = Nothing
+
+instance IsPrivDataSource PrivDataSource where
+ privDataField s = case s of
+ PrivDataSourceFile f _ -> f
+ PrivDataSourceFileFromCommand f _ _ -> f
+ PrivDataSource f _ -> f
+ describePrivDataSource s = Just $ case s of
+ PrivDataSourceFile _ f -> "< " ++ f
+ PrivDataSourceFileFromCommand _ f c ->
+ "< " ++ f ++ " (created by running, for example, `" ++ c ++ "` )"
+ PrivDataSource _ d -> "< (" ++ d ++ ")"
+
+-- | A context in which a PrivDataField is used.
--
-- Often this will be a domain name. For example,
-- Context "www.example.com" could be used for the SSL cert
-- for the web server serving that domain. Multiple hosts might
-- use that privdata.
+--
+-- This appears in serialized privdata files.
newtype Context = Context String
deriving (Read, Show, Ord, Eq)
+-- | A context that may vary depending on the HostName where it's used.
+newtype HostContext = HostContext { mkHostContext :: HostName -> Context }
+
+instance Show HostContext where
+ show hc = show $ mkHostContext hc "<hostname>"
+
+instance Ord HostContext where
+ a <= b = show a <= show b
+
+instance Eq HostContext where
+ a == b = show a == show b
+
+-- | Class of things that can be used as a Context.
+class IsContext c where
+ asContext :: HostName -> c -> Context
+ asHostContext :: c -> HostContext
+
+instance IsContext HostContext where
+ asContext = flip mkHostContext
+ asHostContext = id
+
+instance IsContext Context where
+ asContext _ c = c
+ asHostContext = HostContext . const
+
-- | Use when a PrivDataField is not dependent on any paricular context.
anyContext :: Context
anyContext = Context "any"
-type PrivData = String
+-- | Makes a HostContext that consists just of the hostname.
+hostContext :: HostContext
+hostContext = HostContext Context
+
+-- | Contains the actual private data.
+--
+-- Note that this may contain exta newlines at the end, or they may have
+-- been stripped off, depending on how the user entered the privdata,
+-- and which version of propellor stored it. Use the accessor functions
+-- below to avoid newline problems.
+newtype PrivData = PrivData String
+
+-- | When PrivData is the content of a file, this is the lines thereof.
+privDataLines :: PrivData -> [String]
+privDataLines (PrivData s) = lines s
+
+-- | When the PrivData is a single value, like a password, this extracts
+-- it. Note that if multiple lines are present in the PrivData, only
+-- the first is returned; there is never a newline in the String.
+privDataVal :: PrivData -> String
+privDataVal (PrivData s) = fromMaybe "" (headMaybe (lines s))
+
+-- | Use to get ByteString out of PrivData.
+privDataByteString :: PrivData -> L.ByteString
+privDataByteString (PrivData s) = encodeBS s
data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
- deriving (Read, Show, Ord, Eq)
+ deriving (Read, Show, Ord, Eq, Enum, Bounded)
+
+-- | Parameter that would be passed to ssh-keygen to generate key of this type
+sshKeyTypeParam :: SshKeyType -> String
+sshKeyTypeParam SshRsa = "RSA"
+sshKeyTypeParam SshDsa = "DSA"
+sshKeyTypeParam SshEcdsa = "ECDSA"
+sshKeyTypeParam SshEd25519 = "ED25519"
+
+data DnsSecKey
+ = PubZSK -- ^ DNSSEC Zone Signing Key (public)
+ | PrivZSK -- ^ DNSSEC Zone Signing Key (private)
+ | PubKSK -- ^ DNSSEC Key Signing Key (public)
+ | PrivKSK -- ^ DNSSEC Key Signing Key (private)
+ deriving (Read, Show, Ord, Eq, Bounded, Enum)
diff --git a/src/Propellor/Types/Result.hs b/src/Propellor/Types/Result.hs
new file mode 100644
index 00000000..e8510abf
--- /dev/null
+++ b/src/Propellor/Types/Result.hs
@@ -0,0 +1,38 @@
+module Propellor.Types.Result where
+
+import System.Console.ANSI
+import Data.Monoid
+import Prelude
+
+-- | There can be three results of satisfying a Property.
+data Result = NoChange | MadeChange | FailedChange
+ deriving (Read, Show, Eq)
+
+instance Monoid Result where
+ mempty = NoChange
+
+ mappend FailedChange _ = FailedChange
+ mappend _ FailedChange = FailedChange
+ mappend MadeChange _ = MadeChange
+ mappend _ MadeChange = MadeChange
+ mappend NoChange NoChange = NoChange
+
+class ToResult t where
+ toResult :: t -> Result
+
+instance ToResult Bool where
+ toResult False = FailedChange
+ toResult True = MadeChange
+
+-- | Results of actions, with color.
+class ActionResult a where
+ getActionResult :: a -> (String, ColorIntensity, Color)
+
+instance ActionResult Bool where
+ getActionResult False = ("failed", Vivid, Red)
+ getActionResult True = ("done", Dull, Green)
+
+instance ActionResult Result where
+ getActionResult NoChange = ("ok", Dull, Green)
+ getActionResult MadeChange = ("done", Vivid, Green)
+ getActionResult FailedChange = ("failed", Vivid, Red)
diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs
new file mode 100644
index 00000000..f03c174f
--- /dev/null
+++ b/src/Propellor/Types/ResultCheck.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+
+module Propellor.Types.ResultCheck (
+ UncheckedProperty,
+ unchecked,
+ checkResult,
+ check,
+ Checkable,
+ assume,
+) where
+
+import Propellor.Types
+import Propellor.Exception
+import Utility.Monad
+
+import Data.Monoid
+
+-- | This is a `Property` but its `Result` is not accurate; in particular
+-- it may return `NoChange` despite having made a change.
+--
+-- However, when it returns `MadeChange`, it really did make a change,
+-- and `FailedChange` is still an error.
+data UncheckedProperty i = UncheckedProperty (Property i)
+
+instance TightenTargets UncheckedProperty where
+ tightenTargets (UncheckedProperty p) = UncheckedProperty (tightenTargets p)
+
+-- | Use to indicate that a Property is unchecked.
+unchecked :: Property i -> UncheckedProperty i
+unchecked = UncheckedProperty
+
+-- | Checks the result of a property. Mostly used to convert a
+-- `UncheckedProperty` to a `Property`, but can also be used to further
+-- check a `Property`.
+checkResult
+ :: (Checkable p i, LiftPropellor m)
+ => m a
+ -- ^ Run before ensuring the property.
+ -> (a -> m Result)
+ -- ^ Run after ensuring the property. Return `MadeChange` if a
+ -- change was detected, or `NoChange` if no change was detected.
+ -> p i
+ -> Property i
+checkResult precheck postcheck p = adjustPropertySatisfy (checkedProp p) $ \satisfy -> do
+ a <- liftPropellor precheck
+ r <- catchPropellor satisfy
+ -- Always run postcheck, even if the result is already MadeChange,
+ -- as it may need to clean up after precheck.
+ r' <- liftPropellor $ postcheck a
+ return (r <> r')
+
+-- | Makes a `Property` or an `UncheckedProperty` only run
+-- when a test succeeds.
+check :: (Checkable p i, LiftPropellor m) => m Bool -> p i -> Property i
+check test p = adjustPropertySatisfy (preCheckedProp p) $ \satisfy ->
+ ifM (liftPropellor test)
+ ( satisfy
+ , return NoChange
+ )
+
+class Checkable p i where
+ checkedProp :: p i -> Property i
+ preCheckedProp :: p i -> Property i
+
+instance Checkable Property i where
+ checkedProp = id
+ preCheckedProp = id
+
+instance Checkable UncheckedProperty i where
+ checkedProp (UncheckedProperty p) = p
+ -- Since it was pre-checked that the property needed to be run,
+ -- if the property succeeded, we can assume it made a change.
+ preCheckedProp (UncheckedProperty p) = p `assume` MadeChange
+
+-- | Sometimes it's not practical to test if a property made a change.
+-- In such a case, it's often fine to say:
+--
+-- > someprop `assume` MadeChange
+--
+-- However, beware assuming `NoChange`, as that will make combinators
+-- like `onChange` not work.
+assume :: Checkable p i => p i -> Result -> Property i
+assume p result = adjustPropertySatisfy (checkedProp p) $ \satisfy -> do
+ r <- satisfy
+ return (r <> result)
diff --git a/src/Propellor/Types/Singletons.hs b/src/Propellor/Types/Singletons.hs
new file mode 100644
index 00000000..f2089ee8
--- /dev/null
+++ b/src/Propellor/Types/Singletons.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE CPP, DataKinds, PolyKinds, TypeOperators, TypeFamilies, GADTs, UndecidableInstances #-}
+
+-- | Simple implementation of singletons, portable back to ghc 7.6.3
+
+module Propellor.Types.Singletons (
+ module Propellor.Types.Singletons,
+ KProxy(..)
+) where
+
+#if __GLASGOW_HASKELL__ > 707
+import Data.Proxy (KProxy(..))
+#else
+data KProxy (a :: *) = KProxy
+#endif
+
+-- | The data family of singleton types.
+data family Sing (x :: k)
+
+-- | A class used to pass singleton values implicitly.
+class SingI t where
+ sing :: Sing t
+
+-- Lists of singletons
+data instance Sing (x :: [k]) where
+ Nil :: Sing '[]
+ Cons :: Sing x -> Sing xs -> Sing (x ': xs)
+instance (SingI x, SingI xs) => SingI (x ': xs) where sing = Cons sing sing
+instance SingI '[] where sing = Nil
+
+data instance Sing (x :: Bool) where
+ TrueS :: Sing 'True
+ FalseS :: Sing 'False
+instance SingI 'True where sing = TrueS
+instance SingI 'False where sing = FalseS
+
+class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where
+ type DemoteRep kparam :: *
+ -- | From singleton to value.
+ fromSing :: Sing (a :: k) -> DemoteRep kparam
+
+instance SingKind ('KProxy :: KProxy a) => SingKind ('KProxy :: KProxy [a]) where
+ type DemoteRep ('KProxy :: KProxy [a]) = [DemoteRep ('KProxy :: KProxy a)]
+ fromSing Nil = []
+ fromSing (Cons x xs) = fromSing x : fromSing xs
+
+instance SingKind ('KProxy :: KProxy Bool) where
+ type DemoteRep ('KProxy :: KProxy Bool) = Bool
+ fromSing FalseS = False
+ fromSing TrueS = True
diff --git a/src/Propellor/Types/ZFS.hs b/src/Propellor/Types/ZFS.hs
new file mode 100644
index 00000000..3ce4b22c
--- /dev/null
+++ b/src/Propellor/Types/ZFS.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE ConstrainedClassMethods #-}
+-- | Types for ZFS Properties.
+--
+-- Copyright 2016 Evan Cofsky <evan@theunixman.com>
+-- License: BSD 2-clause
+
+module Propellor.Types.ZFS where
+
+import Data.String
+import qualified Data.Set as Set
+import qualified Data.String.Utils as SU
+import Data.List
+
+-- | A single ZFS filesystem.
+data ZFS = ZFS ZPool ZDataset deriving (Show, Eq, Ord)
+
+-- | Represents a zpool.
+data ZPool = ZPool String deriving (Show, Eq, Ord)
+
+-- | Represents a dataset in a zpool.
+--
+-- Can be constructed from a / separated string.
+data ZDataset = ZDataset [String] deriving (Eq, Ord)
+
+type ZFSProperties = Set.Set ZFSProperty
+
+fromList :: [ZFSProperty] -> ZFSProperties
+fromList = Set.fromList
+
+toPropertyList :: ZFSProperties -> [(String, String)]
+toPropertyList = Set.foldr (\p l -> l ++ [toPair p]) []
+
+fromPropertyList :: [(String, String)] -> ZFSProperties
+fromPropertyList props =
+ Set.fromList $ map fromPair props
+
+zfsName :: ZFS -> String
+zfsName (ZFS (ZPool pool) dataset) = intercalate "/" [pool, show dataset]
+
+instance Show ZDataset where
+ show (ZDataset paths) = intercalate "/" paths
+
+instance IsString ZDataset where
+ fromString s = ZDataset $ SU.split "/" s
+
+instance IsString ZPool where
+ fromString p = ZPool p
+
+class Value a where
+ toValue :: a -> String
+ fromValue :: (IsString a) => String -> a
+ fromValue = fromString
+
+data ZFSYesNo = ZFSYesNo Bool deriving (Show, Eq, Ord)
+data ZFSOnOff = ZFSOnOff Bool deriving (Show, Eq, Ord)
+data ZFSSize = ZFSSize Integer deriving (Show, Eq, Ord)
+data ZFSString = ZFSString String deriving (Show, Eq, Ord)
+
+instance Value ZFSYesNo where
+ toValue (ZFSYesNo True) = "yes"
+ toValue (ZFSYesNo False) = "no"
+
+instance Value ZFSOnOff where
+ toValue (ZFSOnOff True) = "on"
+ toValue (ZFSOnOff False) = "off"
+
+instance Value ZFSSize where
+ toValue (ZFSSize s) = show s
+
+instance Value ZFSString where
+ toValue (ZFSString s) = s
+
+instance IsString ZFSString where
+ fromString = ZFSString
+
+instance IsString ZFSYesNo where
+ fromString "yes" = ZFSYesNo True
+ fromString "no" = ZFSYesNo False
+ fromString _ = error "Not yes or no"
+
+instance IsString ZFSOnOff where
+ fromString "on" = ZFSOnOff True
+ fromString "off" = ZFSOnOff False
+ fromString _ = error "Not on or off"
+
+data ZFSACLInherit = AIDiscard | AINoAllow | AISecure | AIPassthrough deriving (Show, Eq, Ord)
+instance IsString ZFSACLInherit where
+ fromString "discard" = AIDiscard
+ fromString "noallow" = AINoAllow
+ fromString "secure" = AISecure
+ fromString "passthrough" = AIPassthrough
+ fromString _ = error "Not valid aclpassthrough value"
+
+instance Value ZFSACLInherit where
+ toValue AIDiscard = "discard"
+ toValue AINoAllow = "noallow"
+ toValue AISecure = "secure"
+ toValue AIPassthrough = "passthrough"
+
+data ZFSACLMode = AMDiscard | AMGroupmask | AMPassthrough deriving (Show, Eq, Ord)
+instance IsString ZFSACLMode where
+ fromString "discard" = AMDiscard
+ fromString "groupmask" = AMGroupmask
+ fromString "passthrough" = AMPassthrough
+ fromString _ = error "Invalid zfsaclmode"
+
+instance Value ZFSACLMode where
+ toValue AMDiscard = "discard"
+ toValue AMGroupmask = "groupmask"
+ toValue AMPassthrough = "passthrough"
+
+data ZFSProperty = Mounted ZFSYesNo
+ | Mountpoint ZFSString
+ | ReadOnly ZFSYesNo
+ | ACLInherit ZFSACLInherit
+ | ACLMode ZFSACLMode
+ | StringProperty String ZFSString
+ deriving (Show, Eq, Ord)
+
+toPair :: ZFSProperty -> (String, String)
+toPair (Mounted v) = ("mounted", toValue v)
+toPair (Mountpoint v) = ("mountpoint", toValue v)
+toPair (ReadOnly v) = ("readonly", toValue v)
+toPair (ACLInherit v) = ("aclinherit", toValue v)
+toPair (ACLMode v) = ("aclmode", toValue v)
+toPair (StringProperty s v) = (s, toValue v)
+
+fromPair :: (String, String) -> ZFSProperty
+fromPair ("mounted", v) = Mounted (fromString v)
+fromPair ("mountpoint", v) = Mountpoint (fromString v)
+fromPair ("readonly", v) = ReadOnly (fromString v)
+fromPair ("aclinherit", v) = ACLInherit (fromString v)
+fromPair ("aclmode", v) = ACLMode (fromString v)
+fromPair (s, v) = StringProperty s (fromString v)
diff --git a/src/Propellor/Utilities.hs b/src/Propellor/Utilities.hs
new file mode 100644
index 00000000..33af4eda
--- /dev/null
+++ b/src/Propellor/Utilities.hs
@@ -0,0 +1,27 @@
+-- | Re-exports some of propellor's internal utility modules.
+--
+-- These are used in the implementation of propellor, including some of its
+-- properties. However, there is no API stability; any of these can change
+-- or be removed without a major version number increase.
+--
+-- Use outside propellor at your own risk.
+
+module Propellor.Utilities (
+ module Utility.PartialPrelude
+ , module Utility.Process
+ , module Utility.Exception
+ , module Utility.Env
+ , module Utility.Directory
+ , module Utility.Tmp
+ , module Utility.Monad
+ , module Utility.Misc
+) where
+
+import Utility.PartialPrelude
+import Utility.Process
+import Utility.Exception
+import Utility.Env
+import Utility.Directory
+import Utility.Tmp
+import Utility.Monad
+import Utility.Misc
diff --git a/src/System/Console/Concurrent.hs b/src/System/Console/Concurrent.hs
new file mode 100644
index 00000000..12447637
--- /dev/null
+++ b/src/System/Console/Concurrent.hs
@@ -0,0 +1,44 @@
+-- |
+-- Copyright: 2015 Joey Hess <id@joeyh.name>
+-- License: BSD-2-clause
+--
+-- Concurrent output handling.
+--
+-- > import Control.Concurrent.Async
+-- > import System.Console.Concurrent
+-- >
+-- > main = withConcurrentOutput $
+-- > outputConcurrent "washed the car\n"
+-- > `concurrently`
+-- > outputConcurrent "walked the dog\n"
+-- > `concurrently`
+-- > createProcessConcurrent (proc "ls" [])
+
+{-# LANGUAGE CPP #-}
+
+module System.Console.Concurrent (
+ -- * Concurrent output
+ withConcurrentOutput,
+ Outputable(..),
+ outputConcurrent,
+ errorConcurrent,
+ ConcurrentProcessHandle,
+#ifndef mingw32_HOST_OS
+ createProcessConcurrent,
+#endif
+ waitForProcessConcurrent,
+ createProcessForeground,
+ flushConcurrentOutput,
+ lockOutput,
+ -- * Low level access to the output buffer
+ OutputBuffer,
+ StdHandle(..),
+ bufferOutputSTM,
+ outputBufferWaiterSTM,
+ waitAnyBuffer,
+ waitCompleteLines,
+ emitOutputBuffer,
+) where
+
+import System.Console.Concurrent.Internal
+
diff --git a/src/System/Console/Concurrent/Internal.hs b/src/System/Console/Concurrent/Internal.hs
new file mode 100644
index 00000000..ffe6a9e8
--- /dev/null
+++ b/src/System/Console/Concurrent/Internal.hs
@@ -0,0 +1,546 @@
+{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances, TupleSections #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -O2 #-}
+{- Building this module with -O0 causes streams not to fuse and too much
+ - memory to be used. -}
+
+-- |
+-- Copyright: 2015 Joey Hess <id@joeyh.name>
+-- License: BSD-2-clause
+--
+-- Concurrent output handling, internals.
+--
+-- May change at any time.
+
+module System.Console.Concurrent.Internal where
+
+import System.IO
+#ifndef mingw32_HOST_OS
+import System.Posix.IO
+#endif
+import System.Directory
+import System.Exit
+import Control.Monad
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import System.IO.Unsafe (unsafePerformIO)
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Concurrent.Async
+import Data.Maybe
+import Data.List
+import Data.Monoid
+import qualified System.Process as P
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Control.Applicative
+import Prelude
+
+import Utility.Monad
+import Utility.Exception
+
+data OutputHandle = OutputHandle
+ { outputLock :: TMVar Lock
+ , outputBuffer :: TMVar OutputBuffer
+ , errorBuffer :: TMVar OutputBuffer
+ , outputThreads :: TMVar Integer
+ , processWaiters :: TMVar [Async ()]
+ , waitForProcessLock :: TMVar ()
+ }
+
+data Lock = Locked
+
+-- | A shared global variable for the OutputHandle.
+{-# NOINLINE globalOutputHandle #-}
+globalOutputHandle :: OutputHandle
+globalOutputHandle = unsafePerformIO $ OutputHandle
+ <$> newEmptyTMVarIO
+ <*> newTMVarIO (OutputBuffer [])
+ <*> newTMVarIO (OutputBuffer [])
+ <*> newTMVarIO 0
+ <*> newTMVarIO []
+ <*> newEmptyTMVarIO
+
+-- | Holds a lock while performing an action. This allows the action to
+-- perform its own output to the console, without using functions from this
+-- module.
+--
+-- While this is running, other threads that try to lockOutput will block.
+-- Any calls to `outputConcurrent` and `createProcessConcurrent` will not
+-- block, but the output will be buffered and displayed only once the
+-- action is done.
+lockOutput :: (MonadIO m, MonadMask m) => m a -> m a
+lockOutput = bracket_ (liftIO takeOutputLock) (liftIO dropOutputLock)
+
+-- | Blocks until we have the output lock.
+takeOutputLock :: IO ()
+takeOutputLock = void $ takeOutputLock' True
+
+-- | Tries to take the output lock, without blocking.
+tryTakeOutputLock :: IO Bool
+tryTakeOutputLock = takeOutputLock' False
+
+withLock :: (TMVar Lock -> STM a) -> IO a
+withLock a = atomically $ a (outputLock globalOutputHandle)
+
+takeOutputLock' :: Bool -> IO Bool
+takeOutputLock' block = do
+ locked <- withLock $ \l -> do
+ v <- tryTakeTMVar l
+ case v of
+ Just Locked
+ | block -> retry
+ | otherwise -> do
+ -- Restore value we took.
+ putTMVar l Locked
+ return False
+ Nothing -> do
+ putTMVar l Locked
+ return True
+ when locked $ do
+ (outbuf, errbuf) <- atomically $ (,)
+ <$> swapTMVar (outputBuffer globalOutputHandle) (OutputBuffer [])
+ <*> swapTMVar (errorBuffer globalOutputHandle) (OutputBuffer [])
+ emitOutputBuffer StdOut outbuf
+ emitOutputBuffer StdErr errbuf
+ return locked
+
+-- | Only safe to call after taking the output lock.
+dropOutputLock :: IO ()
+dropOutputLock = withLock $ void . takeTMVar
+
+-- | Use this around any actions that use `outputConcurrent`
+-- or `createProcessConcurrent`
+--
+-- This is necessary to ensure that buffered concurrent output actually
+-- gets displayed before the program exits.
+withConcurrentOutput :: (MonadIO m, MonadMask m) => m a -> m a
+withConcurrentOutput a = a `finally` liftIO flushConcurrentOutput
+
+-- | Blocks until any processes started by `createProcessConcurrent` have
+-- finished, and any buffered output is displayed. Also blocks while
+-- `lockOutput` is is use.
+--
+-- `withConcurrentOutput` calls this at the end, so you do not normally
+-- need to use this.
+flushConcurrentOutput :: IO ()
+flushConcurrentOutput = do
+ atomically $ do
+ r <- takeTMVar (outputThreads globalOutputHandle)
+ if r <= 0
+ then putTMVar (outputThreads globalOutputHandle) r
+ else retry
+ -- Take output lock to wait for anything else that might be
+ -- currently generating output.
+ lockOutput $ return ()
+
+-- | Values that can be output.
+class Outputable v where
+ toOutput :: v -> T.Text
+
+instance Outputable T.Text where
+ toOutput = id
+
+instance Outputable String where
+ toOutput = toOutput . T.pack
+
+-- | Displays a value to stdout.
+--
+-- No newline is appended to the value, so if you want a newline, be sure
+-- to include it yourself.
+--
+-- Uses locking to ensure that the whole output occurs atomically
+-- even when other threads are concurrently generating output.
+--
+-- When something else is writing to the console at the same time, this does
+-- not block. It buffers the value, so it will be displayed once the other
+-- writer is done.
+outputConcurrent :: Outputable v => v -> IO ()
+outputConcurrent = outputConcurrent' StdOut
+
+-- | Like `outputConcurrent`, but displays to stderr.
+--
+-- (Does not throw an exception.)
+errorConcurrent :: Outputable v => v -> IO ()
+errorConcurrent = outputConcurrent' StdErr
+
+outputConcurrent' :: Outputable v => StdHandle -> v -> IO ()
+outputConcurrent' stdh v = bracket setup cleanup go
+ where
+ setup = tryTakeOutputLock
+ cleanup False = return ()
+ cleanup True = dropOutputLock
+ go True = do
+ T.hPutStr h (toOutput v)
+ hFlush h
+ go False = do
+ oldbuf <- atomically $ takeTMVar bv
+ newbuf <- addOutputBuffer (Output (toOutput v)) oldbuf
+ atomically $ putTMVar bv newbuf
+ h = toHandle stdh
+ bv = bufferFor stdh
+
+newtype ConcurrentProcessHandle = ConcurrentProcessHandle P.ProcessHandle
+
+toConcurrentProcessHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle) -> (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
+toConcurrentProcessHandle (i, o, e, h) = (i, o, e, ConcurrentProcessHandle h)
+
+-- | Use this to wait for processes started with
+-- `createProcessConcurrent` and `createProcessForeground`, and get their
+-- exit status.
+--
+-- Note that such processes are actually automatically waited for
+-- internally, so not calling this explicitly will not result
+-- in zombie processes. This behavior differs from `P.waitForProcess`
+waitForProcessConcurrent :: ConcurrentProcessHandle -> IO ExitCode
+waitForProcessConcurrent (ConcurrentProcessHandle h) =
+ bracket lock unlock checkexit
+ where
+ lck = waitForProcessLock globalOutputHandle
+ lock = atomically $ tryPutTMVar lck ()
+ unlock True = atomically $ takeTMVar lck
+ unlock False = return ()
+ checkexit locked = maybe (waitsome locked) return
+ =<< P.getProcessExitCode h
+ waitsome True = do
+ let v = processWaiters globalOutputHandle
+ l <- atomically $ readTMVar v
+ if null l
+ -- Avoid waitAny [] which blocks forever
+ then P.waitForProcess h
+ else do
+ -- Wait for any of the running
+ -- processes to exit. It may or may not
+ -- be the one corresponding to the
+ -- ProcessHandle. If it is,
+ -- getProcessExitCode will succeed.
+ void $ tryIO $ waitAny l
+ checkexit True
+ waitsome False = do
+ -- Another thread took the lck first. Wait for that thread to
+ -- wait for one of the running processes to exit.
+ atomically $ do
+ putTMVar lck ()
+ takeTMVar lck
+ checkexit False
+
+-- Registers an action that waits for a process to exit,
+-- adding it to the processWaiters list, and removing it once the action
+-- completes.
+asyncProcessWaiter :: IO () -> IO ()
+asyncProcessWaiter waitaction = do
+ regdone <- newEmptyTMVarIO
+ waiter <- async $ do
+ self <- atomically (takeTMVar regdone)
+ waitaction `finally` unregister self
+ register waiter regdone
+ where
+ v = processWaiters globalOutputHandle
+ register waiter regdone = atomically $ do
+ l <- takeTMVar v
+ putTMVar v (waiter:l)
+ putTMVar regdone waiter
+ unregister waiter = atomically $ do
+ l <- takeTMVar v
+ putTMVar v (filter (/= waiter) l)
+
+-- | Wrapper around `System.Process.createProcess` that prevents
+-- multiple processes that are running concurrently from writing
+-- to stdout/stderr at the same time.
+--
+-- If the process does not output to stdout or stderr, it's run
+-- by createProcess entirely as usual. Only processes that can generate
+-- output are handled specially:
+--
+-- A process is allowed to write to stdout and stderr in the usual
+-- way, assuming it can successfully take the output lock.
+--
+-- When the output lock is held (ie, by another concurrent process,
+-- or because `outputConcurrent` is being called at the same time),
+-- the process is instead run with its stdout and stderr
+-- redirected to a buffer. The buffered output will be displayed as soon
+-- as the output lock becomes free.
+--
+-- Currently only available on Unix systems, not Windows.
+#ifndef mingw32_HOST_OS
+createProcessConcurrent :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
+createProcessConcurrent p
+ | willOutput (P.std_out p) || willOutput (P.std_err p) =
+ ifM tryTakeOutputLock
+ ( fgProcess p
+ , bgProcess p
+ )
+ | otherwise = do
+ r@(_, _, _, h) <- P.createProcess p
+ asyncProcessWaiter $
+ void $ tryIO $ P.waitForProcess h
+ return (toConcurrentProcessHandle r)
+#endif
+
+-- | Wrapper around `System.Process.createProcess` that makes sure a process
+-- is run in the foreground, with direct access to stdout and stderr.
+-- Useful when eg, running an interactive process.
+createProcessForeground :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
+createProcessForeground p = do
+ takeOutputLock
+ fgProcess p
+
+fgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
+fgProcess p = do
+ r@(_, _, _, h) <- P.createProcess p
+ `onException` dropOutputLock
+ registerOutputThread
+ -- Wait for the process to exit and drop the lock.
+ asyncProcessWaiter $ do
+ void $ tryIO $ P.waitForProcess h
+ unregisterOutputThread
+ dropOutputLock
+ return (toConcurrentProcessHandle r)
+
+#ifndef mingw32_HOST_OS
+bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
+bgProcess p = do
+ (toouth, fromouth) <- pipe
+ (toerrh, fromerrh) <- pipe
+ let p' = p
+ { P.std_out = rediroutput (P.std_out p) toouth
+ , P.std_err = rediroutput (P.std_err p) toerrh
+ }
+ registerOutputThread
+ r@(_, _, _, h) <- P.createProcess p'
+ `onException` unregisterOutputThread
+ asyncProcessWaiter $ void $ tryIO $ P.waitForProcess h
+ outbuf <- setupOutputBuffer StdOut toouth (P.std_out p) fromouth
+ errbuf <- setupOutputBuffer StdErr toerrh (P.std_err p) fromerrh
+ void $ async $ bufferWriter [outbuf, errbuf]
+ return (toConcurrentProcessHandle r)
+ where
+ pipe = do
+ (from, to) <- createPipe
+ (,) <$> fdToHandle to <*> fdToHandle from
+ rediroutput ss h
+ | willOutput ss = P.UseHandle h
+ | otherwise = ss
+#endif
+
+willOutput :: P.StdStream -> Bool
+willOutput P.Inherit = True
+willOutput _ = False
+
+-- | Buffered output.
+data OutputBuffer = OutputBuffer [OutputBufferedActivity]
+ deriving (Eq)
+
+data StdHandle = StdOut | StdErr
+
+toHandle :: StdHandle -> Handle
+toHandle StdOut = stdout
+toHandle StdErr = stderr
+
+bufferFor :: StdHandle -> TMVar OutputBuffer
+bufferFor StdOut = outputBuffer globalOutputHandle
+bufferFor StdErr = errorBuffer globalOutputHandle
+
+data OutputBufferedActivity
+ = Output T.Text
+ | InTempFile
+ { tempFile :: FilePath
+ , endsInNewLine :: Bool
+ }
+ deriving (Eq)
+
+data AtEnd = AtEnd
+ deriving Eq
+
+data BufSig = BufSig
+
+setupOutputBuffer :: StdHandle -> Handle -> P.StdStream -> Handle -> IO (StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)
+setupOutputBuffer h toh ss fromh = do
+ hClose toh
+ buf <- newMVar (OutputBuffer [])
+ bufsig <- atomically newEmptyTMVar
+ bufend <- atomically newEmptyTMVar
+ void $ async $ outputDrainer ss fromh buf bufsig bufend
+ return (h, buf, bufsig, bufend)
+
+-- Drain output from the handle, and buffer it.
+outputDrainer :: P.StdStream -> Handle -> MVar OutputBuffer -> TMVar BufSig -> TMVar AtEnd -> IO ()
+outputDrainer ss fromh buf bufsig bufend
+ | willOutput ss = go
+ | otherwise = atend
+ where
+ go = do
+ t <- T.hGetChunk fromh
+ if T.null t
+ then atend
+ else do
+ modifyMVar_ buf $ addOutputBuffer (Output t)
+ changed
+ go
+ atend = do
+ atomically $ putTMVar bufend AtEnd
+ hClose fromh
+ changed = atomically $ do
+ void $ tryTakeTMVar bufsig
+ putTMVar bufsig BufSig
+
+registerOutputThread :: IO ()
+registerOutputThread = do
+ let v = outputThreads globalOutputHandle
+ atomically $ putTMVar v . succ =<< takeTMVar v
+
+unregisterOutputThread :: IO ()
+unregisterOutputThread = do
+ let v = outputThreads globalOutputHandle
+ atomically $ putTMVar v . pred =<< takeTMVar v
+
+-- Wait to lock output, and once we can, display everything
+-- that's put into the buffers, until the end.
+--
+-- If end is reached before lock is taken, instead add the command's
+-- buffers to the global outputBuffer and errorBuffer.
+bufferWriter :: [(StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)] -> IO ()
+bufferWriter ts = do
+ activitysig <- atomically newEmptyTMVar
+ worker1 <- async $ lockOutput $
+ ifM (atomically $ tryPutTMVar activitysig ())
+ ( void $ mapConcurrently displaybuf ts
+ , noop -- buffers already moved to global
+ )
+ worker2 <- async $ void $ globalbuf activitysig worker1
+ void $ async $ do
+ void $ waitCatch worker1
+ void $ waitCatch worker2
+ unregisterOutputThread
+ where
+ displaybuf v@(outh, buf, bufsig, bufend) = do
+ change <- atomically $
+ (Right <$> takeTMVar bufsig)
+ `orElse`
+ (Left <$> takeTMVar bufend)
+ l <- takeMVar buf
+ putMVar buf (OutputBuffer [])
+ emitOutputBuffer outh l
+ case change of
+ Right BufSig -> displaybuf v
+ Left AtEnd -> return ()
+ globalbuf activitysig worker1 = do
+ ok <- atomically $ do
+ -- signal we're going to handle it
+ -- (returns false if the displaybuf already did)
+ ok <- tryPutTMVar activitysig ()
+ -- wait for end of all buffers
+ when ok $
+ mapM_ (\(_outh, _buf, _bufsig, bufend) -> takeTMVar bufend) ts
+ return ok
+ when ok $ do
+ -- add all of the command's buffered output to the
+ -- global output buffer, atomically
+ bs <- forM ts $ \(outh, buf, _bufsig, _bufend) ->
+ (outh,) <$> takeMVar buf
+ atomically $
+ forM_ bs $ \(outh, b) ->
+ bufferOutputSTM' outh b
+ -- worker1 might be blocked waiting for the output
+ -- lock, and we've already done its job, so cancel it
+ cancel worker1
+
+-- Adds a value to the OutputBuffer. When adding Output to a Handle,
+-- it's cheaper to combine it with any already buffered Output to that
+-- same Handle.
+--
+-- When the total buffered Output exceeds 1 mb in size, it's moved out of
+-- memory, to a temp file. This should only happen rarely, but is done to
+-- avoid some verbose process unexpectedly causing excessive memory use.
+addOutputBuffer :: OutputBufferedActivity -> OutputBuffer -> IO OutputBuffer
+addOutputBuffer (Output t) (OutputBuffer buf)
+ | T.length t' <= 1048576 = return $ OutputBuffer (Output t' : other)
+ | otherwise = do
+ tmpdir <- getTemporaryDirectory
+ (tmp, h) <- openTempFile tmpdir "output.tmp"
+ let !endnl = endsNewLine t'
+ let i = InTempFile
+ { tempFile = tmp
+ , endsInNewLine = endnl
+ }
+ T.hPutStr h t'
+ hClose h
+ return $ OutputBuffer (i : other)
+ where
+ !t' = T.concat (mapMaybe getOutput this) <> t
+ !(this, other) = partition isOutput buf
+ isOutput v = case v of
+ Output _ -> True
+ _ -> False
+ getOutput v = case v of
+ Output t'' -> Just t''
+ _ -> Nothing
+addOutputBuffer v (OutputBuffer buf) = return $ OutputBuffer (v:buf)
+
+-- | Adds a value to the output buffer for later display.
+--
+-- Note that buffering large quantities of data this way will keep it
+-- resident in memory until it can be displayed. While `outputConcurrent`
+-- uses temp files if the buffer gets too big, this STM function cannot do
+-- so.
+bufferOutputSTM :: Outputable v => StdHandle -> v -> STM ()
+bufferOutputSTM h v = bufferOutputSTM' h (OutputBuffer [Output (toOutput v)])
+
+bufferOutputSTM' :: StdHandle -> OutputBuffer -> STM ()
+bufferOutputSTM' h (OutputBuffer newbuf) = do
+ (OutputBuffer buf) <- takeTMVar bv
+ putTMVar bv (OutputBuffer (newbuf ++ buf))
+ where
+ bv = bufferFor h
+
+-- | A STM action that waits for some buffered output to become
+-- available, and returns it.
+--
+-- The function can select a subset of output when only some is desired;
+-- the fst part is returned and the snd is left in the buffer.
+--
+-- This will prevent it from being displayed in the usual way, so you'll
+-- need to use `emitOutputBuffer` to display it yourself.
+outputBufferWaiterSTM :: (OutputBuffer -> (OutputBuffer, OutputBuffer)) -> STM (StdHandle, OutputBuffer)
+outputBufferWaiterSTM selector = waitgetbuf StdOut `orElse` waitgetbuf StdErr
+ where
+ waitgetbuf h = do
+ let bv = bufferFor h
+ (selected, rest) <- selector <$> takeTMVar bv
+ when (selected == OutputBuffer [])
+ retry
+ putTMVar bv rest
+ return (h, selected)
+
+waitAnyBuffer :: OutputBuffer -> (OutputBuffer, OutputBuffer)
+waitAnyBuffer b = (b, OutputBuffer [])
+
+-- | Use with `outputBufferWaiterSTM` to make it only return buffered
+-- output that ends with a newline. Anything buffered without a newline
+-- is left in the buffer.
+waitCompleteLines :: OutputBuffer -> (OutputBuffer, OutputBuffer)
+waitCompleteLines (OutputBuffer l) =
+ let (selected, rest) = span completeline l
+ in (OutputBuffer selected, OutputBuffer rest)
+ where
+ completeline (v@(InTempFile {})) = endsInNewLine v
+ completeline (Output b) = endsNewLine b
+
+endsNewLine :: T.Text -> Bool
+endsNewLine t = not (T.null t) && T.last t == '\n'
+
+-- | Emits the content of the OutputBuffer to the Handle
+--
+-- If you use this, you should use `lockOutput` to ensure you're the only
+-- thread writing to the console.
+emitOutputBuffer :: StdHandle -> OutputBuffer -> IO ()
+emitOutputBuffer stdh (OutputBuffer l) =
+ forM_ (reverse l) $ \ba -> case ba of
+ Output t -> emit t
+ InTempFile tmp _ -> do
+ emit =<< T.readFile tmp
+ void $ tryWhenExists $ removeFile tmp
+ where
+ outh = toHandle stdh
+ emit t = void $ tryIO $ do
+ T.hPutStr outh t
+ hFlush outh
diff --git a/src/System/Process/Concurrent.hs b/src/System/Process/Concurrent.hs
new file mode 100644
index 00000000..0e00e4fd
--- /dev/null
+++ b/src/System/Process/Concurrent.hs
@@ -0,0 +1,34 @@
+-- |
+-- Copyright: 2015 Joey Hess <id@joeyh.name>
+-- License: BSD-2-clause
+--
+-- The functions exported by this module are intended to be drop-in
+-- replacements for those from System.Process, when converting a whole
+-- program to use System.Console.Concurrent.
+
+module System.Process.Concurrent where
+
+import System.Console.Concurrent
+import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..))
+import System.Process hiding (createProcess, waitForProcess)
+import System.IO
+import System.Exit
+
+-- | Calls `createProcessConcurrent`
+--
+-- You should use the waitForProcess in this module on the resulting
+-- ProcessHandle. Using System.Process.waitForProcess instead can have
+-- mildly unexpected results.
+createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
+createProcess p = do
+ (i, o, e, ConcurrentProcessHandle h) <- createProcessConcurrent p
+ return (i, o, e, h)
+
+-- | Calls `waitForProcessConcurrent`
+--
+-- You should only use this on a ProcessHandle obtained by calling
+-- createProcess from this module. Using this with a ProcessHandle
+-- obtained from System.Process.createProcess etc will have extremely
+-- unexpected results; it can wait a very long time before returning.
+waitForProcess :: ProcessHandle -> IO ExitCode
+waitForProcess = waitForProcessConcurrent . ConcurrentProcessHandle
diff --git a/src/Utility/Applicative.hs b/src/Utility/Applicative.hs
index fd8944b2..fce3c048 100644
--- a/src/Utility/Applicative.hs
+++ b/src/Utility/Applicative.hs
@@ -1,6 +1,6 @@
{- applicative stuff
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
diff --git a/src/Utility/Data.hs b/src/Utility/Data.hs
index 2df12b36..27c0a824 100644
--- a/src/Utility/Data.hs
+++ b/src/Utility/Data.hs
@@ -1,10 +1,12 @@
{- utilities for simple data types
-
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Utility.Data where
{- First item in the list that is not Nothing. -}
diff --git a/src/Utility/DataUnits.hs b/src/Utility/DataUnits.hs
new file mode 100644
index 00000000..6e40932e
--- /dev/null
+++ b/src/Utility/DataUnits.hs
@@ -0,0 +1,162 @@
+{- data size display and parsing
+ -
+ - Copyright 2011 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -
+ -
+ - And now a rant:
+ -
+ - In the beginning, we had powers of two, and they were good.
+ -
+ - Disk drive manufacturers noticed that some powers of two were
+ - sorta close to some powers of ten, and that rounding down to the nearest
+ - power of ten allowed them to advertise their drives were bigger. This
+ - was sorta annoying.
+ -
+ - Then drives got big. Really, really big. This was good.
+ -
+ - Except that the small rounding error perpretrated by the drive
+ - manufacturers suffered the fate of a small error, and became a large
+ - error. This was bad.
+ -
+ - So, a committee was formed. And it arrived at a committee-like decision,
+ - which satisfied noone, confused everyone, and made the world an uglier
+ - place. As with all committees, this was meh.
+ -
+ - And the drive manufacturers happily continued selling drives that are
+ - increasingly smaller than you'd expect, if you don't count on your
+ - fingers. But that are increasingly too big for anyone to much notice.
+ - This caused me to need git-annex.
+ -
+ - Thus, I use units here that I loathe. Because if I didn't, people would
+ - be confused that their drives seem the wrong size, and other people would
+ - complain at me for not being standards compliant. And we call this
+ - progress?
+ -}
+
+module Utility.DataUnits (
+ dataUnits,
+ storageUnits,
+ memoryUnits,
+ bandwidthUnits,
+ oldSchoolUnits,
+ Unit(..),
+ ByteSize,
+
+ roughSize,
+ compareSizes,
+ readSize
+) where
+
+import Data.List
+import Data.Char
+
+import Utility.HumanNumber
+
+type ByteSize = Integer
+type Name = String
+type Abbrev = String
+data Unit = Unit ByteSize Abbrev Name
+ deriving (Ord, Show, Eq)
+
+dataUnits :: [Unit]
+dataUnits = storageUnits ++ memoryUnits
+
+{- Storage units are (stupidly) powers of ten. -}
+storageUnits :: [Unit]
+storageUnits =
+ [ Unit (p 8) "YB" "yottabyte"
+ , Unit (p 7) "ZB" "zettabyte"
+ , Unit (p 6) "EB" "exabyte"
+ , Unit (p 5) "PB" "petabyte"
+ , Unit (p 4) "TB" "terabyte"
+ , Unit (p 3) "GB" "gigabyte"
+ , Unit (p 2) "MB" "megabyte"
+ , Unit (p 1) "kB" "kilobyte" -- weird capitalization thanks to committe
+ , Unit (p 0) "B" "byte"
+ ]
+ where
+ p :: Integer -> Integer
+ p n = 1000^n
+
+{- Memory units are (stupidly named) powers of 2. -}
+memoryUnits :: [Unit]
+memoryUnits =
+ [ Unit (p 8) "YiB" "yobibyte"
+ , Unit (p 7) "ZiB" "zebibyte"
+ , Unit (p 6) "EiB" "exbibyte"
+ , Unit (p 5) "PiB" "pebibyte"
+ , Unit (p 4) "TiB" "tebibyte"
+ , Unit (p 3) "GiB" "gibibyte"
+ , Unit (p 2) "MiB" "mebibyte"
+ , Unit (p 1) "KiB" "kibibyte"
+ , Unit (p 0) "B" "byte"
+ ]
+ where
+ p :: Integer -> Integer
+ p n = 2^(n*10)
+
+{- Bandwidth units are only measured in bits if you're some crazy telco. -}
+bandwidthUnits :: [Unit]
+bandwidthUnits = error "stop trying to rip people off"
+
+{- Do you yearn for the days when men were men and megabytes were megabytes? -}
+oldSchoolUnits :: [Unit]
+oldSchoolUnits = zipWith (curry mingle) storageUnits memoryUnits
+ where
+ mingle (Unit _ a n, Unit s' _ _) = Unit s' a n
+
+{- approximate display of a particular number of bytes -}
+roughSize :: [Unit] -> Bool -> ByteSize -> String
+roughSize units short i
+ | i < 0 = '-' : findUnit units' (negate i)
+ | otherwise = findUnit units' i
+ where
+ units' = sortBy (flip compare) units -- largest first
+
+ findUnit (u@(Unit s _ _):us) i'
+ | i' >= s = showUnit i' u
+ | otherwise = findUnit us i'
+ findUnit [] i' = showUnit i' (last units') -- bytes
+
+ showUnit x (Unit size abbrev name) = s ++ " " ++ unit
+ where
+ v = (fromInteger x :: Double) / fromInteger size
+ s = showImprecise 2 v
+ unit
+ | short = abbrev
+ | s == "1" = name
+ | otherwise = name ++ "s"
+
+{- displays comparison of two sizes -}
+compareSizes :: [Unit] -> Bool -> ByteSize -> ByteSize -> String
+compareSizes units abbrev old new
+ | old > new = roughSize units abbrev (old - new) ++ " smaller"
+ | old < new = roughSize units abbrev (new - old) ++ " larger"
+ | otherwise = "same"
+
+{- Parses strings like "10 kilobytes" or "0.5tb". -}
+readSize :: [Unit] -> String -> Maybe ByteSize
+readSize units input
+ | null parsednum || null parsedunit = Nothing
+ | otherwise = Just $ round $ number * fromIntegral multiplier
+ where
+ (number, rest) = head parsednum
+ multiplier = head parsedunit
+ unitname = takeWhile isAlpha $ dropWhile isSpace rest
+
+ parsednum = reads input :: [(Double, String)]
+ parsedunit = lookupUnit units unitname
+
+ lookupUnit _ [] = [1] -- no unit given, assume bytes
+ lookupUnit [] _ = []
+ lookupUnit (Unit s a n:us) v
+ | a ~~ v || n ~~ v = [s]
+ | plural n ~~ v || a ~~ byteabbrev v = [s]
+ | otherwise = lookupUnit us v
+
+ a ~~ b = map toLower a == map toLower b
+
+ plural n = n ++ "s"
+ byteabbrev a = a ++ "b"
diff --git a/src/Utility/Directory.hs b/src/Utility/Directory.hs
index d92327c0..693e7713 100644
--- a/src/Utility/Directory.hs
+++ b/src/Utility/Directory.hs
@@ -1,25 +1,37 @@
-{- directory manipulation
+{- directory traversal and manipulation
-
- - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
-module Utility.Directory where
+module Utility.Directory (
+ module Utility.Directory,
+ module Utility.SystemDirectory
+) where
import System.IO.Error
-import System.Directory
-import Control.Exception (throw)
import Control.Monad
-import Control.Monad.IfElse
import System.FilePath
import Control.Applicative
+import Control.Concurrent
import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.Maybe
+import Prelude
-import Utility.PosixFiles
+#ifdef mingw32_HOST_OS
+import qualified System.Win32 as Win32
+#else
+import qualified System.Posix as Posix
import Utility.SafeCommand
+import Control.Monad.IfElse
+#endif
+
+import Utility.SystemDirectory
+import Utility.PosixFiles
import Utility.Tmp
import Utility.Exception
import Utility.Monad
@@ -49,7 +61,7 @@ dirContentsRecursive = dirContentsRecursiveSkipping (const False) True
dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]
dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
where
- go [] = return []
+ go [] = return []
go (dir:dirs)
| skipdir (takeFileName dir) = go dirs
| otherwise = unsafeInterleaveIO $ do
@@ -80,7 +92,7 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
where
- go c [] = return c
+ go c [] = return c
go c (dir:dirs)
| skipdir (takeFileName dir) = go c dirs
| otherwise = unsafeInterleaveIO $ do
@@ -98,27 +110,40 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
onrename (Left e)
| isPermissionError e = rethrow
| isDoesNotExistError e = rethrow
- | otherwise = do
- -- copyFile is likely not as optimised as
- -- the mv command, so we'll use the latter.
- -- But, mv will move into a directory if
- -- dest is one, which is not desired.
- whenM (isdir dest) rethrow
- viaTmp mv dest undefined
+ | otherwise = viaTmp mv dest ""
where
- rethrow = throw e
+ rethrow = throwM e
+
mv tmp _ = do
+ -- copyFile is likely not as optimised as
+ -- the mv command, so we'll use the command.
+ --
+ -- But, while Windows has a "mv", it does not seem very
+ -- reliable, so use copyFile there.
+#ifndef mingw32_HOST_OS
+ -- If dest is a directory, mv would move the file
+ -- into it, which is not desired.
+ whenM (isdir dest) rethrow
ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
+ let e' = e
+#else
+ r <- tryIO $ copyFile src tmp
+ let (ok, e') = case r of
+ Left err -> (False, err)
+ Right _ -> (True, e)
+#endif
unless ok $ do
-- delete any partial
_ <- tryIO $ removeFile tmp
- rethrow
+ throwM e'
+#ifndef mingw32_HOST_OS
isdir f = do
r <- tryIO $ getFileStatus f
case r of
(Left _) -> return False
(Right s) -> return $ isDirectory s
+#endif
{- Removes a file, which may or may not exist, and does not have to
- be a regular file.
@@ -133,3 +158,90 @@ nukeFile file = void $ tryWhenExists go
#else
go = removeFile file
#endif
+
+#ifndef mingw32_HOST_OS
+data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
+#else
+data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())
+#endif
+
+type IsOpen = MVar () -- full when the handle is open
+
+openDirectory :: FilePath -> IO DirectoryHandle
+openDirectory path = do
+#ifndef mingw32_HOST_OS
+ dirp <- Posix.openDirStream path
+ isopen <- newMVar ()
+ return (DirectoryHandle isopen dirp)
+#else
+ (h, fdat) <- Win32.findFirstFile (path </> "*")
+ -- Indicate that the fdat contains a filename that readDirectory
+ -- has not yet returned, by making the MVar be full.
+ -- (There's always at least a "." entry.)
+ alreadyhave <- newMVar ()
+ isopen <- newMVar ()
+ return (DirectoryHandle isopen h fdat alreadyhave)
+#endif
+
+closeDirectory :: DirectoryHandle -> IO ()
+#ifndef mingw32_HOST_OS
+closeDirectory (DirectoryHandle isopen dirp) =
+ whenOpen isopen $
+ Posix.closeDirStream dirp
+#else
+closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
+ whenOpen isopen $ do
+ _ <- tryTakeMVar alreadyhave
+ Win32.findClose h
+#endif
+ where
+ whenOpen :: IsOpen -> IO () -> IO ()
+ whenOpen mv f = do
+ v <- tryTakeMVar mv
+ when (isJust v) f
+
+{- |Reads the next entry from the handle. Once the end of the directory
+is reached, returns Nothing and automatically closes the handle.
+-}
+readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
+#ifndef mingw32_HOST_OS
+readDirectory hdl@(DirectoryHandle _ dirp) = do
+ e <- Posix.readDirStream dirp
+ if null e
+ then do
+ closeDirectory hdl
+ return Nothing
+ else return (Just e)
+#else
+readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
+ -- If the MVar is full, then the filename in fdat has
+ -- not yet been returned. Otherwise, need to find the next
+ -- file.
+ r <- tryTakeMVar mv
+ case r of
+ Just () -> getfn
+ Nothing -> do
+ more <- Win32.findNextFile h fdat
+ if more
+ then getfn
+ else do
+ closeDirectory hdl
+ return Nothing
+ where
+ getfn = do
+ filename <- Win32.getFindDataFileName fdat
+ return (Just filename)
+#endif
+
+-- True only when directory exists and contains nothing.
+-- Throws exception if directory does not exist.
+isDirectoryEmpty :: FilePath -> IO Bool
+isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check
+ where
+ check h = do
+ v <- readDirectory h
+ case v of
+ Nothing -> return True
+ Just f
+ | not (dirCruft f) -> return False
+ | otherwise -> check h
diff --git a/src/Utility/Env.hs b/src/Utility/Env.hs
index 6763c24e..c56f4ec2 100644
--- a/src/Utility/Env.hs
+++ b/src/Utility/Env.hs
@@ -1,11 +1,12 @@
{- portable environment variables
-
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Env where
@@ -13,7 +14,9 @@ module Utility.Env where
import Utility.Exception
import Control.Applicative
import Data.Maybe
+import Prelude
import qualified System.Environment as E
+import qualified System.SetEnv
#else
import qualified System.Posix.Env as PE
#endif
@@ -39,27 +42,27 @@ getEnvironment = PE.getEnvironment
getEnvironment = E.getEnvironment
#endif
-{- Returns True if it could successfully set the environment variable.
+{- Sets an environment variable. To overwrite an existing variable,
+ - overwrite must be True.
-
- - There is, apparently, no way to do this in Windows. Instead,
- - environment varuables must be provided when running a new process. -}
-setEnv :: String -> String -> Bool -> IO Bool
+ - On Windows, setting a variable to "" unsets it. -}
+setEnv :: String -> String -> Bool -> IO ()
#ifndef mingw32_HOST_OS
-setEnv var val overwrite = do
- PE.setEnv var val overwrite
- return True
+setEnv var val overwrite = PE.setEnv var val overwrite
#else
-setEnv _ _ _ = return False
+setEnv var val True = System.SetEnv.setEnv var val
+setEnv var val False = do
+ r <- getEnv var
+ case r of
+ Nothing -> setEnv var val True
+ Just _ -> return ()
#endif
-{- Returns True if it could successfully unset the environment variable. -}
-unsetEnv :: String -> IO Bool
+unsetEnv :: String -> IO ()
#ifndef mingw32_HOST_OS
-unsetEnv var = do
- PE.unsetEnv var
- return True
+unsetEnv = PE.unsetEnv
#else
-unsetEnv _ = return False
+unsetEnv = System.SetEnv.unsetEnv
#endif
{- Adds the environment variable to the input environment. If already
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
index 1fecf65d..e691f13b 100644
--- a/src/Utility/Exception.hs
+++ b/src/Utility/Exception.hs
@@ -1,59 +1,103 @@
{- Simple IO exception handling (and some more)
-
- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2015 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
-module Utility.Exception where
+module Utility.Exception (
+ module X,
+ catchBoolIO,
+ catchMaybeIO,
+ catchDefaultIO,
+ catchMsgIO,
+ catchIO,
+ tryIO,
+ bracketIO,
+ catchNonAsync,
+ tryNonAsync,
+ tryWhenExists,
+ catchIOErrorType,
+ IOErrorType(..),
+ catchPermissionDenied,
+) where
-import Control.Exception
-import qualified Control.Exception as E
-import Control.Applicative
+import Control.Monad.Catch as X hiding (Handler)
+import qualified Control.Monad.Catch as M
+import Control.Exception (IOException, AsyncException)
import Control.Monad
-import System.IO.Error (isDoesNotExistError)
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
+import GHC.IO.Exception (IOErrorType(..))
+
import Utility.Data
{- Catches IO errors and returns a Bool -}
-catchBoolIO :: IO Bool -> IO Bool
+catchBoolIO :: MonadCatch m => m Bool -> m Bool
catchBoolIO = catchDefaultIO False
{- Catches IO errors and returns a Maybe -}
-catchMaybeIO :: IO a -> IO (Maybe a)
-catchMaybeIO a = catchDefaultIO Nothing $ Just <$> a
+catchMaybeIO :: MonadCatch m => m a -> m (Maybe a)
+catchMaybeIO a = catchDefaultIO Nothing $ a >>= (return . Just)
{- Catches IO errors and returns a default value. -}
-catchDefaultIO :: a -> IO a -> IO a
+catchDefaultIO :: MonadCatch m => a -> m a -> m a
catchDefaultIO def a = catchIO a (const $ return def)
{- Catches IO errors and returns the error message. -}
-catchMsgIO :: IO a -> IO (Either String a)
-catchMsgIO a = either (Left . show) Right <$> tryIO a
+catchMsgIO :: MonadCatch m => m a -> m (Either String a)
+catchMsgIO a = do
+ v <- tryIO a
+ return $ either (Left . show) Right v
{- catch specialized for IO errors only -}
-catchIO :: IO a -> (IOException -> IO a) -> IO a
-catchIO = E.catch
+catchIO :: MonadCatch m => m a -> (IOException -> m a) -> m a
+catchIO = M.catch
{- try specialized for IO errors only -}
-tryIO :: IO a -> IO (Either IOException a)
-tryIO = try
+tryIO :: MonadCatch m => m a -> m (Either IOException a)
+tryIO = M.try
+
+{- bracket with setup and cleanup actions lifted to IO.
+ -
+ - Note that unlike catchIO and tryIO, this catches all exceptions. -}
+bracketIO :: (MonadMask m, MonadIO m) => IO v -> (v -> IO b) -> (v -> m a) -> m a
+bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup)
{- Catches all exceptions except for async exceptions.
- This is often better to use than catching them all, so that
- ThreadKilled and UserInterrupt get through.
-}
-catchNonAsync :: IO a -> (SomeException -> IO a) -> IO a
+catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a
catchNonAsync a onerr = a `catches`
- [ Handler (\ (e :: AsyncException) -> throw e)
- , Handler (\ (e :: SomeException) -> onerr e)
+ [ M.Handler (\ (e :: AsyncException) -> throwM e)
+ , M.Handler (\ (e :: SomeException) -> onerr e)
]
-tryNonAsync :: IO a -> IO (Either SomeException a)
-tryNonAsync a = (Right <$> a) `catchNonAsync` (return . Left)
+tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)
+tryNonAsync a = go `catchNonAsync` (return . Left)
+ where
+ go = do
+ v <- a
+ return (Right v)
{- Catches only DoesNotExist exceptions, and lets all others through. -}
-tryWhenExists :: IO a -> IO (Maybe a)
-tryWhenExists a = eitherToMaybe <$>
- tryJust (guard . isDoesNotExistError) a
+tryWhenExists :: MonadCatch m => m a -> m (Maybe a)
+tryWhenExists a = do
+ v <- tryJust (guard . isDoesNotExistError) a
+ return (eitherToMaybe v)
+
+{- Catches only IO exceptions of a particular type.
+ - Ie, use HardwareFault to catch disk IO errors. -}
+catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
+catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
+ where
+ onlymatching e
+ | ioeGetErrorType e == errtype = onmatchingerr e
+ | otherwise = throwM e
+
+catchPermissionDenied :: MonadCatch m => (IOException -> m a) -> m a -> m a
+catchPermissionDenied = catchIOErrorType PermissionDenied
diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs
index c2ef683a..bb3780c6 100644
--- a/src/Utility/FileMode.hs
+++ b/src/Utility/FileMode.hs
@@ -1,29 +1,35 @@
{- File mode utilities.
-
- - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
-module Utility.FileMode where
+module Utility.FileMode (
+ module Utility.FileMode,
+ FileMode,
+) where
import System.IO
import Control.Monad
-import Control.Exception (bracket)
import System.PosixCompat.Types
import Utility.PosixFiles
#ifndef mingw32_HOST_OS
import System.Posix.Files
+import Control.Monad.IO.Class (liftIO)
#endif
+import Control.Monad.IO.Class (MonadIO)
import Foreign (complement)
+import Control.Monad.Catch
import Utility.Exception
{- Applies a conversion function to a file's mode. -}
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
modifyFileMode f convert = void $ modifyFileMode' f convert
+
modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
modifyFileMode' f convert = do
s <- getFileStatus f
@@ -33,6 +39,14 @@ modifyFileMode' f convert = do
setFileMode f new
return old
+{- Runs an action after changing a file's mode, then restores the old mode. -}
+withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
+withModifiedFileMode file convert a = bracket setup cleanup go
+ where
+ setup = modifyFileMode' file convert
+ cleanup oldmode = modifyFileMode file (const oldmode)
+ go _ = a
+
{- Adds the specified FileModes to the input mode, leaving the rest
- unchanged. -}
addModes :: [FileMode] -> FileMode -> FileMode
@@ -42,14 +56,6 @@ addModes ms m = combineModes (m:ms)
removeModes :: [FileMode] -> FileMode -> FileMode
removeModes ms m = m `intersectFileModes` complement (combineModes ms)
-{- Runs an action after changing a file's mode, then restores the old mode. -}
-withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
-withModifiedFileMode file convert a = bracket setup cleanup go
- where
- setup = modifyFileMode' file convert
- cleanup oldmode = modifyFileMode file (const oldmode)
- go _ = a
-
writeModes :: [FileMode]
writeModes = [ownerWriteMode, groupWriteMode, otherWriteMode]
@@ -104,7 +110,7 @@ isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0
{- Runs an action without that pesky umask influencing it, unless the
- passed FileMode is the standard one. -}
-noUmask :: FileMode -> IO a -> IO a
+noUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
#ifndef mingw32_HOST_OS
noUmask mode a
| mode == stdFileMode = a
@@ -113,19 +119,19 @@ noUmask mode a
noUmask _ a = a
#endif
-withUmask :: FileMode -> IO a -> IO a
+withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
#ifndef mingw32_HOST_OS
withUmask umask a = bracket setup cleanup go
where
- setup = setFileCreationMask umask
- cleanup = setFileCreationMask
+ setup = liftIO $ setFileCreationMask umask
+ cleanup = liftIO . setFileCreationMask
go _ = a
#else
withUmask _ a = a
#endif
combineModes :: [FileMode] -> FileMode
-combineModes [] = undefined
+combineModes [] = 0
combineModes [m] = m
combineModes (m:ms) = foldl unionFileModes m ms
@@ -152,7 +158,11 @@ setSticky f = modifyFileMode f $ addModes [stickyMode]
- as writeFile.
-}
writeFileProtected :: FilePath -> String -> IO ()
-writeFileProtected file content = withUmask 0o0077 $
+writeFileProtected file content = writeFileProtected' file
+ (\h -> hPutStr h content)
+
+writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO ()
+writeFileProtected' file writer = withUmask 0o0077 $
withFile file WriteMode $ \h -> do
void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
- hPutStr h content
+ writer h
diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs
index b81fdc53..eab98337 100644
--- a/src/Utility/FileSystemEncoding.hs
+++ b/src/Utility/FileSystemEncoding.hs
@@ -1,20 +1,25 @@
{- GHC File system encoding handling.
-
- - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.FileSystemEncoding (
fileEncoding,
withFilePath,
md5FilePath,
decodeBS,
+ encodeBS,
decodeW8,
encodeW8,
+ encodeW8NUL,
+ decodeW8NUL,
truncateFilePath,
+ setConsoleEncoding,
) where
import qualified GHC.Foreign as GHC
@@ -25,11 +30,15 @@ import System.IO.Unsafe
import qualified Data.Hash.MD5 as MD5
import Data.Word
import Data.Bits.Utils
+import Data.List
+import Data.List.Utils
import qualified Data.ByteString.Lazy as L
#ifdef mingw32_HOST_OS
import qualified Data.ByteString.Lazy.UTF8 as L8
#endif
+import Utility.Exception
+
{- Sets a Handle to use the filesystem encoding. This causes data
- written or read from it to be encoded/decoded the same
- as ghc 7.4 does to filenames etc. This special encoding
@@ -63,12 +72,16 @@ withFilePath fp f = Encoding.getFileSystemEncoding
- only allows doing this conversion with CStrings, and the CString buffer
- is allocated, used, and deallocated within the call, with no side
- effects.
+ -
+ - If the FilePath contains a value that is not legal in the filesystem
+ - encoding, rather than thowing an exception, it will be returned as-is.
-}
{-# NOINLINE _encodeFilePath #-}
_encodeFilePath :: FilePath -> String
_encodeFilePath fp = unsafePerformIO $ do
enc <- Encoding.getFileSystemEncoding
- GHC.withCString enc fp $ GHC.peekCString Encoding.char8
+ GHC.withCString enc fp (GHC.peekCString Encoding.char8)
+ `catchNonAsync` (\_ -> return fp)
{- Encodes a FilePath into a Md5.Str, applying the filesystem encoding. -}
md5FilePath :: FilePath -> MD5.Str
@@ -77,18 +90,29 @@ md5FilePath = MD5.Str . _encodeFilePath
{- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
decodeBS :: L.ByteString -> FilePath
#ifndef mingw32_HOST_OS
-decodeBS = encodeW8 . L.unpack
+decodeBS = encodeW8NUL . L.unpack
#else
{- On Windows, we assume that the ByteString is utf-8, since Windows
- only uses unicode for filenames. -}
decodeBS = L8.toString
#endif
+{- Encodes a FilePath into a ByteString, applying the filesystem encoding. -}
+encodeBS :: FilePath -> L.ByteString
+#ifndef mingw32_HOST_OS
+encodeBS = L.pack . decodeW8NUL
+#else
+encodeBS = L8.fromString
+#endif
+
{- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
-
- w82c produces a String, which may contain Chars that are invalid
- unicode. From there, this is really a simple matter of applying the
- file system encoding, only complicated by GHC's interface to doing so.
+ -
+ - Note that the encoding stops at any NUL in the input. FilePaths
+ - do not normally contain embedded NUL, but Haskell Strings may.
-}
{-# NOINLINE encodeW8 #-}
encodeW8 :: [Word8] -> FilePath
@@ -101,6 +125,17 @@ encodeW8 w8 = unsafePerformIO $ do
decodeW8 :: FilePath -> [Word8]
decodeW8 = s2w8 . _encodeFilePath
+{- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -}
+encodeW8NUL :: [Word8] -> FilePath
+encodeW8NUL = intercalate nul . map encodeW8 . split (s2w8 nul)
+ where
+ nul = ['\NUL']
+
+decodeW8NUL :: FilePath -> [Word8]
+decodeW8NUL = intercalate (s2w8 nul) . map decodeW8 . split nul
+ where
+ nul = ['\NUL']
+
{- Truncates a FilePath to the given number of bytes (or less),
- as represented on disk.
-
@@ -111,7 +146,7 @@ truncateFilePath :: Int -> FilePath -> FilePath
#ifndef mingw32_HOST_OS
truncateFilePath n = go . reverse
where
- go f =
+ go f =
let bytes = decodeW8 f
in if length bytes <= n
then reverse f
@@ -130,3 +165,10 @@ truncateFilePath n = reverse . go [] n . L8.fromString
else go (c:coll) (cnt - x') (L8.drop 1 bs)
_ -> coll
#endif
+
+{- This avoids ghc's output layer crashing on invalid encoded characters in
+ - filenames when printing them out. -}
+setConsoleEncoding :: IO ()
+setConsoleEncoding = do
+ fileEncoding stdout
+ fileEncoding stderr
diff --git a/src/Utility/HumanNumber.hs b/src/Utility/HumanNumber.hs
new file mode 100644
index 00000000..c3fede95
--- /dev/null
+++ b/src/Utility/HumanNumber.hs
@@ -0,0 +1,21 @@
+{- numbers for humans
+ -
+ - Copyright 2012-2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.HumanNumber where
+
+{- Displays a fractional value as a string with a limited number
+ - of decimal digits. -}
+showImprecise :: RealFrac a => Int -> a -> String
+showImprecise precision n
+ | precision == 0 || remainder == 0 = show (round n :: Integer)
+ | otherwise = show int ++ "." ++ striptrailing0s (pad0s $ show remainder)
+ where
+ int :: Integer
+ (int, frac) = properFraction n
+ remainder = round (frac * 10 ^ precision) :: Integer
+ pad0s s = replicate (precision - length s) '0' ++ s
+ striptrailing0s = reverse . dropWhile (== '0') . reverse
diff --git a/src/Utility/LinuxMkLibs.hs b/src/Utility/LinuxMkLibs.hs
index 1dc4e1ea..122f3964 100644
--- a/src/Utility/LinuxMkLibs.hs
+++ b/src/Utility/LinuxMkLibs.hs
@@ -1,26 +1,27 @@
{- Linux library copier and binary shimmer
-
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
module Utility.LinuxMkLibs where
-import Control.Applicative
-import Data.Maybe
-import System.Directory
-import Data.List.Utils
-import System.Posix.Files
-import Data.Char
-import Control.Monad.IfElse
-
import Utility.PartialPrelude
import Utility.Directory
import Utility.Process
import Utility.Monad
import Utility.Path
+import Data.Maybe
+import System.FilePath
+import Data.List.Utils
+import System.Posix.Files
+import Data.Char
+import Control.Monad.IfElse
+import Control.Applicative
+import Prelude
+
{- Installs a library. If the library is a symlink to another file,
- install the file it links to, and update the symlink to be relative. -}
installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath)
@@ -35,7 +36,7 @@ installLib installfile top lib = ifM (doesFileExist lib)
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
l <- readSymbolicLink (inTop top f)
let absl = absPathFrom (parentDir f) l
- let target = relPathDirToFile (parentDir f) absl
+ target <- relPathDirToFile (takeDirectory f) absl
installfile top absl
nukeFile (top ++ f)
createSymbolicLink target (inTop top f)
diff --git a/src/Utility/Misc.hs b/src/Utility/Misc.hs
index 949f41e7..ebb42576 100644
--- a/src/Utility/Misc.hs
+++ b/src/Utility/Misc.hs
@@ -1,28 +1,30 @@
{- misc utility functions
-
- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2011 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Misc where
+import Utility.FileSystemEncoding
+import Utility.Monad
+
import System.IO
import Control.Monad
import Foreign
import Data.Char
import Data.List
-import Control.Applicative
import System.Exit
#ifndef mingw32_HOST_OS
import System.Posix.Process (getAnyProcessStatus)
import Utility.Exception
#endif
-
-import Utility.FileSystemEncoding
-import Utility.Monad
+import Control.Applicative
+import Prelude
{- A version of hgetContents that is not lazy. Ensures file is
- all read before it gets closed. -}
@@ -134,7 +136,7 @@ hGetSomeString h sz = do
- if this reap gets there first. -}
reapZombies :: IO ()
#ifndef mingw32_HOST_OS
-reapZombies = do
+reapZombies =
-- throws an exception when there are no child processes
catchDefaultIO Nothing (getAnyProcessStatus False True)
>>= maybe (return ()) (const reapZombies)
diff --git a/src/Utility/Monad.hs b/src/Utility/Monad.hs
index eba3c428..ac751043 100644
--- a/src/Utility/Monad.hs
+++ b/src/Utility/Monad.hs
@@ -1,10 +1,12 @@
{- monadic stuff
-
- - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Utility.Monad where
import Data.Maybe
diff --git a/src/Utility/PartialPrelude.hs b/src/Utility/PartialPrelude.hs
index 6efa093f..55795563 100644
--- a/src/Utility/PartialPrelude.hs
+++ b/src/Utility/PartialPrelude.hs
@@ -5,6 +5,8 @@
- them being accidentially used.
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Utility.PartialPrelude where
import qualified Data.Maybe
diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs
index 99c9438b..3ee5ff39 100644
--- a/src/Utility/Path.hs
+++ b/src/Utility/Path.hs
@@ -1,34 +1,37 @@
{- path manipulation
-
- - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE PackageImports, CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Path where
import Data.String.Utils
import System.FilePath
-import System.Directory
import Data.List
import Data.Maybe
import Data.Char
import Control.Applicative
+import Prelude
#ifdef mingw32_HOST_OS
import qualified System.FilePath.Posix as Posix
#else
import System.Posix.Files
+import Utility.Exception
#endif
import qualified "MissingH" System.Path as MissingH
import Utility.Monad
import Utility.UserInfo
+import Utility.Directory
-{- Simplifies a path, removing any ".." or ".", and removing the trailing
- - path separator.
+{- Simplifies a path, removing any "." component, collapsing "dir/..",
+ - and removing the trailing path separator.
-
- On Windows, preserves whichever style of path separator might be used in
- the input FilePaths. This is done because some programs in Windows
@@ -47,7 +50,8 @@ simplifyPath path = dropTrailingPathSeparator $
norm c [] = reverse c
norm c (p:ps)
- | p' == ".." = norm (drop 1 c) ps
+ | p' == ".." && not (null c) && dropTrailingPathSeparator (c !! 0) /= ".." =
+ norm (drop 1 c) ps
| p' == "." = norm c ps
| otherwise = norm (p:c) ps
where
@@ -56,7 +60,7 @@ simplifyPath path = dropTrailingPathSeparator $
{- Makes a path absolute.
-
- The first parameter is a base directory (ie, the cwd) to use if the path
- - is not already absolute.
+ - is not already absolute, and should itsef be absolute.
-
- Does not attempt to deal with edge cases or ensure security with
- untrusted inputs.
@@ -65,7 +69,7 @@ absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom dir path = simplifyPath (combine dir path)
{- On Windows, this converts the paths to unix-style, in order to run
- - MissingH's absNormPath on them. Resulting path will use / separators. -}
+ - MissingH's absNormPath on them. -}
absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath
#ifndef mingw32_HOST_OS
absNormPathUnix dir path = MissingH.absNormPath dir path
@@ -76,27 +80,29 @@ absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos
todos = replace "/" "\\"
#endif
-{- Returns the parent directory of a path.
- -
- - To allow this to be easily used in loops, which terminate upon reaching the
- - top, the parent of / is "" -}
+{- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
parentDir :: FilePath -> FilePath
-parentDir dir
- | null dirs = ""
- | otherwise = joinDrive drive (join s $ init dirs)
+parentDir = takeDirectory . dropTrailingPathSeparator
+
+{- Just the parent directory of a path, or Nothing if the path has no
+- parent (ie for "/" or ".") -}
+upFrom :: FilePath -> Maybe FilePath
+upFrom dir
+ | length dirs < 2 = Nothing
+ | otherwise = Just $ joinDrive drive (intercalate s $ init dirs)
where
-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
(drive, path) = splitDrive dir
dirs = filter (not . null) $ split s path
s = [pathSeparator]
-prop_parentDir_basics :: FilePath -> Bool
-prop_parentDir_basics dir
+prop_upFrom_basics :: FilePath -> Bool
+prop_upFrom_basics dir
| null dir = True
- | dir == "/" = parentDir dir == ""
- | otherwise = p /= dir
+ | dir == "/" = p == Nothing
+ | otherwise = p /= Just dir
where
- p = parentDir dir
+ p = upFrom dir
{- Checks if the first FilePath is, or could be said to contain the second.
- For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
@@ -125,14 +131,25 @@ absPath file = do
- relPathCwdToFile "/tmp/foo/bar" == ""
-}
relPathCwdToFile :: FilePath -> IO FilePath
-relPathCwdToFile f = relPathDirToFile <$> getCurrentDirectory <*> absPath f
+relPathCwdToFile f = do
+ c <- getCurrentDirectory
+ relPathDirToFile c f
-{- Constructs a relative path from a directory to a file.
+{- Constructs a relative path from a directory to a file. -}
+relPathDirToFile :: FilePath -> FilePath -> IO FilePath
+relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
+
+{- This requires the first path to be absolute, and the
+ - second path cannot contain ../ or ./
-
- - Both must be absolute, and cannot contain .. etc. (eg use absPath first).
+ - On Windows, if the paths are on different drives,
+ - a relative path is not possible and the path is simply
+ - returned as-is.
-}
-relPathDirToFile :: FilePath -> FilePath -> FilePath
-relPathDirToFile from to = join s $ dotdots ++ uncommon
+relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
+relPathDirToFileAbs from to
+ | takeDrive from /= takeDrive to = to
+ | otherwise = intercalate s $ dotdots ++ uncommon
where
s = [pathSeparator]
pfrom = split s from
@@ -145,10 +162,11 @@ relPathDirToFile from to = join s $ dotdots ++ uncommon
prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics from to
+ | null from || null to = True
| from == to = null r
| otherwise = not (null r)
where
- r = relPathDirToFile from to
+ r = relPathDirToFileAbs from to
prop_relPathDirToFile_regressionTest :: Bool
prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
@@ -157,22 +175,31 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
- location, but it's not really the same directory.
- Code used to get this wrong. -}
same_dir_shortcurcuits_at_difference =
- relPathDirToFile (joinPath [pathSeparator : "tmp", "r", "lll", "xxx", "yyy", "18"])
+ relPathDirToFileAbs (joinPath [pathSeparator : "tmp", "r", "lll", "xxx", "yyy", "18"])
(joinPath [pathSeparator : "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])
== joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]
{- Given an original list of paths, and an expanded list derived from it,
- - generates a list of lists, where each sublist corresponds to one of the
- - original paths. When the original path is a directory, any items
- - in the expanded list that are contained in that directory will appear in
- - its segment.
+ - which may be arbitrarily reordered, generates a list of lists, where
+ - each sublist corresponds to one of the original paths.
+ -
+ - When the original path is a directory, any items in the expanded list
+ - that are contained in that directory will appear in its segment.
+ -
+ - The order of the original list of paths is attempted to be preserved in
+ - the order of the returned segments. However, doing so has a O^NM
+ - growth factor. So, if the original list has more than 100 paths on it,
+ - we stop preserving ordering at that point. Presumably a user passing
+ - that many paths in doesn't care too much about order of the later ones.
-}
segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [] new = [new]
segmentPaths [_] new = [new] -- optimisation
-segmentPaths (l:ls) new = [found] ++ segmentPaths ls rest
+segmentPaths (l:ls) new = found : segmentPaths ls rest
where
- (found, rest)=partition (l `dirContains`) new
+ (found, rest) = if length ls < 100
+ then partition (l `dirContains`) new
+ else break (\p -> not (l `dirContains` p)) new
{- This assumes that it's cheaper to call segmentPaths on the result,
- than it would be to run the action separately with each path. In
@@ -186,7 +213,7 @@ relHome :: FilePath -> IO String
relHome path = do
home <- myHomeDir
return $ if dirContains home path
- then "~/" ++ relPathDirToFile home path
+ then "~/" ++ relPathDirToFileAbs home path
else path
{- Checks if a command is available in PATH.
@@ -225,21 +252,27 @@ dotfile file
where
f = takeFileName file
-{- Converts a DOS style path to a Cygwin style path. Only on Windows.
- - Any trailing '\' is preserved as a trailing '/' -}
-toCygPath :: FilePath -> FilePath
+{- Converts a DOS style path to a msys2 style path. Only on Windows.
+ - Any trailing '\' is preserved as a trailing '/'
+ -
+ - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
+ -
+ - The virtual filesystem contains:
+ - /c, /d, ... mount points for Windows drives
+ -}
+toMSYS2Path :: FilePath -> FilePath
#ifndef mingw32_HOST_OS
-toCygPath = id
+toMSYS2Path = id
#else
-toCygPath p
+toMSYS2Path p
| null drive = recombine parts
- | otherwise = recombine $ "/cygdrive" : driveletter drive : parts
+ | otherwise = recombine $ "/" : driveletter drive : parts
where
- (drive, p') = splitDrive p
+ (drive, p') = splitDrive p
parts = splitDirectories p'
- driveletter = map toLower . takeWhile (/= ':')
+ driveletter = map toLower . takeWhile (/= ':')
recombine = fixtrailing . Posix.joinPath
- fixtrailing s
+ fixtrailing s
| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
| otherwise = s
#endif
@@ -255,11 +288,12 @@ fileNameLengthLimit :: FilePath -> IO Int
fileNameLengthLimit _ = return 255
#else
fileNameLengthLimit dir = do
- l <- fromIntegral <$> getPathVar dir FileNameLimit
+ -- getPathVar can fail due to statfs(2) overflow
+ l <- catchDefaultIO 0 $
+ fromIntegral <$> getPathVar dir FileNameLimit
if l <= 0
then return 255
else return $ minimum [l, 255]
- where
#endif
{- Given a string that we'd like to use as the basis for FilePath, but that
@@ -267,12 +301,13 @@ fileNameLengthLimit dir = do
- sane FilePath.
-
- All spaces and punctuation and other wacky stuff are replaced
- - with '_', except for '.' "../" will thus turn into ".._", which is safe.
+ - with '_', except for '.'
+ - "../" will thus turn into ".._", which is safe.
-}
sanitizeFilePath :: String -> FilePath
sanitizeFilePath = map sanitize
where
- sanitize c
+ sanitize c
| c == '.' = c
| isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_'
| otherwise = c
diff --git a/src/Utility/PosixFiles.hs b/src/Utility/PosixFiles.hs
index 5abbb578..37253da2 100644
--- a/src/Utility/PosixFiles.hs
+++ b/src/Utility/PosixFiles.hs
@@ -1,13 +1,14 @@
{- POSIX files (and compatablity wrappers).
-
- - This is like System.PosixCompat.Files, except with a fixed rename.
+ - This is like System.PosixCompat.Files, but with a few fixes.
-
- - Copyright 2014 Joey Hess <joey@kitenet.net>
+ - Copyright 2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.PosixFiles (
module X,
@@ -20,6 +21,7 @@ import System.PosixCompat.Files as X hiding (rename)
import System.Posix.Files (rename)
#else
import qualified System.Win32.File as Win32
+import qualified System.Win32.HardLink as Win32
#endif
{- System.PosixCompat.Files.rename on Windows calls renameFile,
@@ -31,3 +33,10 @@ import qualified System.Win32.File as Win32
rename :: FilePath -> FilePath -> IO ()
rename src dest = Win32.moveFileEx src dest Win32.mOVEFILE_REPLACE_EXISTING
#endif
+
+{- System.PosixCompat.Files.createLink throws an error, but windows
+ - does support hard links. -}
+#ifdef mingw32_HOST_OS
+createLink :: FilePath -> FilePath -> IO ()
+createLink = Win32.createHardLink
+#endif
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index cd3826d7..ed02f49e 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -1,21 +1,24 @@
{- System.Process enhancements, including additional ways of running
- processes, and logging.
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP, Rank2Types #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Process (
module X,
- CreateProcess,
+ CreateProcess(..),
StdHandle(..),
readProcess,
+ readProcess',
readProcessEnv,
writeReadProcessEnv,
forceSuccessProcess,
+ forceSuccessProcess',
checkSuccessProcess,
ignoreFailureProcess,
createProcessSuccess,
@@ -24,20 +27,27 @@ module Utility.Process (
processTranscript,
processTranscript',
withHandle,
- withBothHandles,
+ withIOHandles,
+ withOEHandles,
withQuietOutput,
+ feedWithQuietOutput,
createProcess,
+ waitForProcess,
startInteractiveProcess,
stdinHandle,
stdoutHandle,
stderrHandle,
+ ioHandles,
processHandle,
devNull,
) where
-import qualified System.Process
-import System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
-import System.Process hiding (createProcess, readProcess)
+import qualified Utility.Process.Shim
+import qualified Utility.Process.Shim as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
+import Utility.Process.Shim hiding (createProcess, readProcess, waitForProcess)
+import Utility.Misc
+import Utility.Exception
+
import System.Exit
import System.IO
import System.Log.Logger
@@ -45,40 +55,39 @@ import Control.Concurrent
import qualified Control.Exception as E
import Control.Monad
#ifndef mingw32_HOST_OS
-import System.Posix.IO
+import qualified System.Posix.IO
#else
import Control.Applicative
#endif
import Data.Maybe
-
-import Utility.Misc
-import Utility.Exception
+import Prelude
type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a
data StdHandle = StdinHandle | StdoutHandle | StderrHandle
deriving (Eq)
-{- Normally, when reading from a process, it does not need to be fed any
- - standard input. -}
+-- | Normally, when reading from a process, it does not need to be fed any
+-- standard input.
readProcess :: FilePath -> [String] -> IO String
readProcess cmd args = readProcessEnv cmd args Nothing
readProcessEnv :: FilePath -> [String] -> Maybe [(String, String)] -> IO String
-readProcessEnv cmd args environ =
- withHandle StdoutHandle createProcessSuccess p $ \h -> do
- output <- hGetContentsStrict h
- hClose h
- return output
+readProcessEnv cmd args environ = readProcess' p
where
p = (proc cmd args)
{ std_out = CreatePipe
, env = environ
}
-{- Runs an action to write to a process on its stdin,
- - returns its output, and also allows specifying the environment.
- -}
+readProcess' :: CreateProcess -> IO String
+readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do
+ output <- hGetContentsStrict h
+ hClose h
+ return output
+
+-- | Runs an action to write to a process on its stdin,
+-- returns its output, and also allows specifying the environment.
writeReadProcessEnv
:: FilePath
-> [String]
@@ -118,19 +127,20 @@ writeReadProcessEnv cmd args environ writestdin adjusthandle = do
, env = environ
}
-{- Waits for a ProcessHandle, and throws an IOError if the process
- - did not exit successfully. -}
+-- | Waits for a ProcessHandle, and throws an IOError if the process
+-- did not exit successfully.
forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()
-forceSuccessProcess p pid = do
- code <- waitForProcess pid
- case code of
- ExitSuccess -> return ()
- ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n
-
-{- Waits for a ProcessHandle and returns True if it exited successfully.
- - Note that using this with createProcessChecked will throw away
- - the Bool, and is only useful to ignore the exit code of a process,
- - while still waiting for it. -}
+forceSuccessProcess p pid = waitForProcess pid >>= forceSuccessProcess' p
+
+forceSuccessProcess' :: CreateProcess -> ExitCode -> IO ()
+forceSuccessProcess' _ ExitSuccess = return ()
+forceSuccessProcess' p (ExitFailure n) = fail $
+ showCmd p ++ " exited " ++ show n
+
+-- | Waits for a ProcessHandle and returns True if it exited successfully.
+-- Note that using this with createProcessChecked will throw away
+-- the Bool, and is only useful to ignore the exit code of a process,
+-- while still waiting for it. -}
checkSuccessProcess :: ProcessHandle -> IO Bool
checkSuccessProcess pid = do
code <- waitForProcess pid
@@ -141,13 +151,13 @@ ignoreFailureProcess pid = do
void $ waitForProcess pid
return True
-{- Runs createProcess, then an action on its handles, and then
- - forceSuccessProcess. -}
+-- | Runs createProcess, then an action on its handles, and then
+-- forceSuccessProcess.
createProcessSuccess :: CreateProcessRunner
createProcessSuccess p a = createProcessChecked (forceSuccessProcess p) p a
-{- Runs createProcess, then an action on its handles, and then
- - a checker action on its exit code, which must wait for the process. -}
+-- | Runs createProcess, then an action on its handles, and then
+-- a checker action on its exit code, which must wait for the process.
createProcessChecked :: (ProcessHandle -> IO b) -> CreateProcessRunner
createProcessChecked checker p a = do
t@(_, _, _, pid) <- createProcess p
@@ -155,31 +165,30 @@ createProcessChecked checker p a = do
_ <- checker pid
either E.throw return r
-{- Leaves the process running, suitable for lazy streaming.
- - Note: Zombies will result, and must be waited on. -}
+-- | Leaves the process running, suitable for lazy streaming.
+-- Note: Zombies will result, and must be waited on.
createBackgroundProcess :: CreateProcessRunner
createBackgroundProcess p a = a =<< createProcess p
-{- Runs a process, optionally feeding it some input, and
- - returns a transcript combining its stdout and stderr, and
- - whether it succeeded or failed. -}
+-- | Runs a process, optionally feeding it some input, and
+-- returns a transcript combining its stdout and stderr, and
+-- whether it succeeded or failed.
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript cmd opts input = processTranscript' cmd opts Nothing input
+processTranscript = processTranscript' id
-processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool)
-processTranscript' cmd opts environ input = do
+processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool)
+processTranscript' modproc cmd opts input = do
#ifndef mingw32_HOST_OS
{- This implementation interleves stdout and stderr in exactly the order
- the process writes them. -}
- (readf, writef) <- createPipe
- readh <- fdToHandle readf
- writeh <- fdToHandle writef
- p@(_, _, _, pid) <- createProcess $
+ (readf, writef) <- System.Posix.IO.createPipe
+ readh <- System.Posix.IO.fdToHandle readf
+ writeh <- System.Posix.IO.fdToHandle writef
+ p@(_, _, _, pid) <- createProcess $ modproc $
(proc cmd opts)
{ std_in = if isJust input then CreatePipe else Inherit
, std_out = UseHandle writeh
, std_err = UseHandle writeh
- , env = environ
}
hClose writeh
@@ -191,12 +200,11 @@ processTranscript' cmd opts environ input = do
return (transcript, ok)
#else
{- This implementation for Windows puts stderr after stdout. -}
- p@(_, _, _, pid) <- createProcess $
+ p@(_, _, _, pid) <- createProcess $ modproc $
(proc cmd opts)
{ std_in = if isJust input then CreatePipe else Inherit
, std_out = CreatePipe
, std_err = CreatePipe
- , env = environ
}
getout <- mkreader (stdoutHandle p)
@@ -226,9 +234,9 @@ processTranscript' cmd opts environ input = do
hClose inh
writeinput Nothing _ = return ()
-{- Runs a CreateProcessRunner, on a CreateProcess structure, that
- - is adjusted to pipe only from/to a single StdHandle, and passes
- - the resulting Handle to an action. -}
+-- | Runs a CreateProcessRunner, on a CreateProcess structure, that
+-- is adjusted to pipe only from/to a single StdHandle, and passes
+-- the resulting Handle to an action.
withHandle
:: StdHandle
-> CreateProcessRunner
@@ -250,13 +258,13 @@ withHandle h creator p a = creator p' $ a . select
| h == StderrHandle =
(stderrHandle, base { std_err = CreatePipe })
-{- Like withHandle, but passes (stdin, stdout) handles to the action. -}
-withBothHandles
+-- | Like withHandle, but passes (stdin, stdout) handles to the action.
+withIOHandles
:: CreateProcessRunner
-> CreateProcess
-> ((Handle, Handle) -> IO a)
-> IO a
-withBothHandles creator p a = creator p' $ a . bothHandles
+withIOHandles creator p a = creator p' $ a . ioHandles
where
p' = p
{ std_in = CreatePipe
@@ -264,8 +272,22 @@ withBothHandles creator p a = creator p' $ a . bothHandles
, std_err = Inherit
}
-{- Forces the CreateProcessRunner to run quietly;
- - both stdout and stderr are discarded. -}
+-- | Like withHandle, but passes (stdout, stderr) handles to the action.
+withOEHandles
+ :: CreateProcessRunner
+ -> CreateProcess
+ -> ((Handle, Handle) -> IO a)
+ -> IO a
+withOEHandles creator p a = creator p' $ a . oeHandles
+ where
+ p' = p
+ { std_in = Inherit
+ , std_out = CreatePipe
+ , std_err = CreatePipe
+ }
+
+-- | Forces the CreateProcessRunner to run quietly;
+-- both stdout and stderr are discarded.
withQuietOutput
:: CreateProcessRunner
-> CreateProcess
@@ -277,6 +299,21 @@ withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do
}
creator p' $ const $ return ()
+-- | Stdout and stderr are discarded, while the process is fed stdin
+-- from the handle.
+feedWithQuietOutput
+ :: CreateProcessRunner
+ -> CreateProcess
+ -> (Handle -> IO a)
+ -> IO a
+feedWithQuietOutput creator p a = withFile devNull WriteMode $ \nullh -> do
+ let p' = p
+ { std_in = CreatePipe
+ , std_out = UseHandle nullh
+ , std_err = UseHandle nullh
+ }
+ creator p' $ a . stdinHandle
+
devNull :: FilePath
#ifndef mingw32_HOST_OS
devNull = "/dev/null"
@@ -284,11 +321,11 @@ devNull = "/dev/null"
devNull = "NUL"
#endif
-{- Extract a desired handle from createProcess's tuple.
- - These partial functions are safe as long as createProcess is run
- - with appropriate parameters to set up the desired handle.
- - Get it wrong and the runtime crash will always happen, so should be
- - easily noticed. -}
+-- | Extract a desired handle from createProcess's tuple.
+-- These partial functions are safe as long as createProcess is run
+-- with appropriate parameters to set up the desired handle.
+-- Get it wrong and the runtime crash will always happen, so should be
+-- easily noticed.
type HandleExtractor = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Handle
stdinHandle :: HandleExtractor
stdinHandle (Just h, _, _, _) = h
@@ -299,38 +336,25 @@ stdoutHandle _ = error "expected stdoutHandle"
stderrHandle :: HandleExtractor
stderrHandle (_, _, Just h, _) = h
stderrHandle _ = error "expected stderrHandle"
-bothHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
-bothHandles (Just hin, Just hout, _, _) = (hin, hout)
-bothHandles _ = error "expected bothHandles"
+ioHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
+ioHandles (Just hin, Just hout, _, _) = (hin, hout)
+ioHandles _ = error "expected ioHandles"
+oeHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
+oeHandles (_, Just hout, Just herr, _) = (hout, herr)
+oeHandles _ = error "expected oeHandles"
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
processHandle (_, _, _, pid) = pid
-{- Debugging trace for a CreateProcess. -}
-debugProcess :: CreateProcess -> IO ()
-debugProcess p = do
- debugM "Utility.Process" $ unwords
- [ action ++ ":"
- , showCmd p
- ]
- where
- action
- | piped (std_in p) && piped (std_out p) = "chat"
- | piped (std_in p) = "feed"
- | piped (std_out p) = "read"
- | otherwise = "call"
- piped Inherit = False
- piped _ = True
-
-{- Shows the command that a CreateProcess will run. -}
+-- | Shows the command that a CreateProcess will run.
showCmd :: CreateProcess -> String
showCmd = go . cmdspec
where
go (ShellCommand s) = s
go (RawCommand c ps) = c ++ " " ++ show ps
-{- Starts an interactive process. Unlike runInteractiveProcess in
- - System.Process, stderr is inherited. -}
+-- | Starts an interactive process. Unlike runInteractiveProcess in
+-- System.Process, stderr is inherited.
startInteractiveProcess
:: FilePath
-> [String]
@@ -346,8 +370,30 @@ startInteractiveProcess cmd args environ = do
(Just from, Just to, _, pid) <- createProcess p
return (pid, to, from)
-{- Wrapper around System.Process function that does debug logging. -}
+-- | Wrapper around 'System.Process.createProcess' that does debug logging.
createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess p = do
debugProcess p
- System.Process.createProcess p
+ Utility.Process.Shim.createProcess p
+
+-- | Debugging trace for a CreateProcess.
+debugProcess :: CreateProcess -> IO ()
+debugProcess p = debugM "Utility.Process" $ unwords
+ [ action ++ ":"
+ , showCmd p
+ ]
+ where
+ action
+ | piped (std_in p) && piped (std_out p) = "chat"
+ | piped (std_in p) = "feed"
+ | piped (std_out p) = "read"
+ | otherwise = "call"
+ piped Inherit = False
+ piped _ = True
+
+-- | Wrapper around 'System.Process.waitForProcess' that does debug logging.
+waitForProcess :: ProcessHandle -> IO ExitCode
+waitForProcess h = do
+ r <- Utility.Process.Shim.waitForProcess h
+ debugM "Utility.Process" ("process done " ++ show r)
+ return r
diff --git a/src/Utility/Process/NonConcurrent.hs b/src/Utility/Process/NonConcurrent.hs
new file mode 100644
index 00000000..d25d2a24
--- /dev/null
+++ b/src/Utility/Process/NonConcurrent.hs
@@ -0,0 +1,35 @@
+{- Running processes in the foreground, not via the concurrent-output
+ - layer.
+ -
+ - Avoid using this in propellor properties!
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Process.NonConcurrent where
+
+import System.Process
+import System.Exit
+import System.IO
+import Utility.SafeCommand
+import Control.Applicative
+import Prelude
+
+boolSystemNonConcurrent :: String -> [CommandParam] -> IO Bool
+boolSystemNonConcurrent cmd params = do
+ (Nothing, Nothing, Nothing, p) <- createProcessNonConcurrent $
+ proc cmd (toCommand params)
+ dispatch <$> waitForProcessNonConcurrent p
+ where
+ dispatch ExitSuccess = True
+ dispatch _ = False
+
+createProcessNonConcurrent :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
+createProcessNonConcurrent = createProcess
+
+waitForProcessNonConcurrent :: ProcessHandle -> IO ExitCode
+waitForProcessNonConcurrent = waitForProcess
diff --git a/src/Utility/Process/Shim.hs b/src/Utility/Process/Shim.hs
new file mode 100644
index 00000000..8c9d41d0
--- /dev/null
+++ b/src/Utility/Process/Shim.hs
@@ -0,0 +1,4 @@
+module Utility.Process.Shim (module X, createProcess, waitForProcess) where
+
+import System.Process as X hiding (createProcess, waitForProcess)
+import System.Process.Concurrent
diff --git a/src/Utility/QuickCheck.hs b/src/Utility/QuickCheck.hs
deleted file mode 100644
index a498ee61..00000000
--- a/src/Utility/QuickCheck.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-{- QuickCheck with additional instances
- -
- - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
- -
- - License: BSD-2-clause
- -}
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-
-module Utility.QuickCheck
- ( module X
- , module Utility.QuickCheck
- ) where
-
-import Test.QuickCheck as X
-import Data.Time.Clock.POSIX
-import System.Posix.Types
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Control.Applicative
-
-instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where
- arbitrary = M.fromList <$> arbitrary
-
-instance (Arbitrary v, Eq v, Ord v) => Arbitrary (S.Set v) where
- arbitrary = S.fromList <$> arbitrary
-
-{- Times before the epoch are excluded. -}
-instance Arbitrary POSIXTime where
- arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral
-
-instance Arbitrary EpochTime where
- arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral
-
-{- Pids are never negative, or 0. -}
-instance Arbitrary ProcessID where
- arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0)
-
-{- Inodes are never negative. -}
-instance Arbitrary FileID where
- arbitrary = nonNegative arbitrarySizedIntegral
-
-{- File sizes are never negative. -}
-instance Arbitrary FileOffset where
- arbitrary = nonNegative arbitrarySizedIntegral
-
-nonNegative :: (Num a, Ord a) => Gen a -> Gen a
-nonNegative g = g `suchThat` (>= 0)
-
-positive :: (Num a, Ord a) => Gen a -> Gen a
-positive g = g `suchThat` (> 0)
diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs
index 04fcf390..5ce17a84 100644
--- a/src/Utility/SafeCommand.hs
+++ b/src/Utility/SafeCommand.hs
@@ -1,85 +1,94 @@
{- safely running shell commands
-
- - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Utility.SafeCommand where
import System.Exit
import Utility.Process
-import System.Process (env)
import Data.String.Utils
-import Control.Applicative
import System.FilePath
import Data.Char
+import Data.List
+import Control.Applicative
+import Prelude
-{- A type for parameters passed to a shell command. A command can
- - be passed either some Params (multiple parameters can be included,
- - whitespace-separated, or a single Param (for when parameters contain
- - whitespace), or a File.
- -}
-data CommandParam = Params String | Param String | File FilePath
+-- | Parameters that can be passed to a shell command.
+data CommandParam
+ = Param String -- ^ A parameter
+ | File FilePath -- ^ The name of a file
deriving (Eq, Show, Ord)
-{- Used to pass a list of CommandParams to a function that runs
- - a command and expects Strings. -}
+-- | Used to pass a list of CommandParams to a function that runs
+-- a command and expects Strings. -}
toCommand :: [CommandParam] -> [String]
-toCommand = concatMap unwrap
+toCommand = map unwrap
where
- unwrap (Param s) = [s]
- unwrap (Params s) = filter (not . null) (split " " s)
+ unwrap (Param s) = s
-- Files that start with a non-alphanumeric that is not a path
-- separator are modified to avoid the command interpreting them as
-- options or other special constructs.
unwrap (File s@(h:_))
- | isAlphaNum h || h `elem` pathseps = [s]
- | otherwise = ["./" ++ s]
- unwrap (File s) = [s]
+ | isAlphaNum h || h `elem` pathseps = s
+ | otherwise = "./" ++ s
+ unwrap (File s) = s
-- '/' is explicitly included because it's an alternative
-- path separator on Windows.
pathseps = pathSeparator:"./"
-{- Run a system command, and returns True or False
- - if it succeeded or failed.
- -}
+-- | Run a system command, and returns True or False if it succeeded or failed.
+--
+-- This and other command running functions in this module log the commands
+-- run at debug level, using System.Log.Logger.
boolSystem :: FilePath -> [CommandParam] -> IO Bool
-boolSystem command params = boolSystemEnv command params Nothing
+boolSystem command params = boolSystem' command params id
-boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
-boolSystemEnv command params environ = dispatch <$> safeSystemEnv command params environ
+boolSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
+boolSystem' command params mkprocess = dispatch <$> safeSystem' command params mkprocess
where
dispatch ExitSuccess = True
dispatch _ = False
-{- Runs a system command, returning the exit status. -}
+boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
+boolSystemEnv command params environ = boolSystem' command params $
+ \p -> p { env = environ }
+
+-- | Runs a system command, returning the exit status.
safeSystem :: FilePath -> [CommandParam] -> IO ExitCode
-safeSystem command params = safeSystemEnv command params Nothing
+safeSystem command params = safeSystem' command params id
-safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode
-safeSystemEnv command params environ = do
- (_, _, _, pid) <- createProcess (proc command $ toCommand params)
- { env = environ }
+safeSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO ExitCode
+safeSystem' command params mkprocess = do
+ (_, _, _, pid) <- createProcess p
waitForProcess pid
+ where
+ p = mkprocess $ proc command (toCommand params)
+
+safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode
+safeSystemEnv command params environ = safeSystem' command params $
+ \p -> p { env = environ }
-{- Wraps a shell command line inside sh -c, allowing it to be run in a
- - login shell that may not support POSIX shell, eg csh. -}
+-- | Wraps a shell command line inside sh -c, allowing it to be run in a
+-- login shell that may not support POSIX shell, eg csh.
shellWrap :: String -> String
shellWrap cmdline = "sh -c " ++ shellEscape cmdline
-{- Escapes a filename or other parameter to be safely able to be exposed to
- - the shell.
- -
- - This method works for POSIX shells, as well as other shells like csh.
- -}
+-- | Escapes a filename or other parameter to be safely able to be exposed to
+-- the shell.
+--
+-- This method works for POSIX shells, as well as other shells like csh.
shellEscape :: String -> String
shellEscape f = "'" ++ escaped ++ "'"
where
-- replace ' with '"'"'
- escaped = join "'\"'\"'" $ split "'" f
+ escaped = intercalate "'\"'\"'" $ split "'" f
-{- Unescapes a set of shellEscaped words or filenames. -}
+-- | Unescapes a set of shellEscaped words or filenames.
shellUnEscape :: String -> [String]
shellUnEscape [] = []
shellUnEscape s = word : shellUnEscape rest
@@ -96,25 +105,32 @@ shellUnEscape s = word : shellUnEscape rest
| c == q = findword w cs
| otherwise = inquote q (w++[c]) cs
-{- For quickcheck. -}
-prop_idempotent_shellEscape :: String -> Bool
-prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s
-prop_idempotent_shellEscape_multiword :: [String] -> Bool
-prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
+-- | For quickcheck.
+prop_isomorphic_shellEscape :: String -> Bool
+prop_isomorphic_shellEscape s = [s] == (shellUnEscape . shellEscape) s
+prop_isomorphic_shellEscape_multiword :: [String] -> Bool
+prop_isomorphic_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
+
+-- | Segments a list of filenames into groups that are all below the maximum
+-- command-line length limit.
+segmentXargsOrdered :: [FilePath] -> [[FilePath]]
+segmentXargsOrdered = reverse . map reverse . segmentXargsUnordered
-{- Segements a list of filenames into groups that are all below the manximum
- - command-line length limit. Does not preserve order. -}
-segmentXargs :: [FilePath] -> [[FilePath]]
-segmentXargs l = go l [] 0 []
+-- | Not preserving order is a little faster, and streams better when
+-- there are a great many filenames.
+segmentXargsUnordered :: [FilePath] -> [[FilePath]]
+segmentXargsUnordered l = go l [] 0 []
where
- go [] c _ r = c:r
+ go [] c _ r = (c:r)
go (f:fs) c accumlen r
- | len < maxlen && newlen > maxlen = go (f:fs) [] 0 (c:r)
+ | newlen > maxlen && len < maxlen = go (f:fs) [] 0 (c:r)
| otherwise = go fs (f:c) newlen r
where
len = length f
newlen = accumlen + len
- {- 10k of filenames per command, well under Linux's 20k limit;
- - allows room for other parameters etc. -}
+ {- 10k of filenames per command, well under 100k limit
+ - of Linux (and OSX has a similar limit);
+ - allows room for other parameters etc. Also allows for
+ - eg, multibyte characters. -}
maxlen = 10240
diff --git a/src/Utility/Scheduled.hs b/src/Utility/Scheduled.hs
index 305410c5..d23aaf03 100644
--- a/src/Utility/Scheduled.hs
+++ b/src/Utility/Scheduled.hs
@@ -1,6 +1,6 @@
{- scheduled activities
-
- - Copyright 2013-2014 Joey Hess <joey@kitenet.net>
+ - Copyright 2013-2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@@ -23,28 +23,28 @@ module Utility.Scheduled (
toRecurrance,
toSchedule,
parseSchedule,
- prop_schedule_roundtrips,
prop_past_sane,
) where
import Utility.Data
-import Utility.QuickCheck
import Utility.PartialPrelude
import Utility.Misc
-import Control.Applicative
import Data.List
import Data.Time.Clock
import Data.Time.LocalTime
import Data.Time.Calendar
import Data.Time.Calendar.WeekDate
import Data.Time.Calendar.OrdinalDate
+import Data.Time.Format ()
import Data.Tuple.Utils
import Data.Char
+import Control.Applicative
+import Prelude
{- Some sort of scheduled event. -}
data Schedule = Schedule Recurrance ScheduledTime
- deriving (Eq, Read, Show, Ord)
+ deriving (Eq, Read, Show, Ord)
data Recurrance
= Daily
@@ -54,7 +54,7 @@ data Recurrance
| Divisible Int Recurrance
-- ^ Days, Weeks, or Months of the year evenly divisible by a number.
-- (Divisible Year is years evenly divisible by a number.)
- deriving (Eq, Read, Show, Ord)
+ deriving (Eq, Read, Show, Ord)
type WeekDay = Int
type MonthDay = Int
@@ -63,7 +63,7 @@ type YearDay = Int
data ScheduledTime
= AnyTime
| SpecificTime Hour Minute
- deriving (Eq, Read, Show, Ord)
+ deriving (Eq, Read, Show, Ord)
type Hour = Int
type Minute = Int
@@ -73,7 +73,7 @@ type Minute = Int
data NextTime
= NextTimeExactly LocalTime
| NextTimeWindow LocalTime LocalTime
- deriving (Eq, Read, Show)
+ deriving (Eq, Read, Show)
startTime :: NextTime -> LocalTime
startTime (NextTimeExactly t) = t
@@ -96,9 +96,9 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
NextTimeExactly t -> window (localDay t) (localDay t)
| otherwise = NextTimeExactly . startTime <$> findfromtoday False
where
- findfromtoday anytime = findfrom recurrance afterday today
+ findfromtoday anytime = findfrom recurrance afterday today
where
- today = localDay currenttime
+ today = localDay currenttime
afterday = sameaslastrun || toolatetoday
toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime
sameaslastrun = lastrun == Just today
@@ -163,8 +163,8 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
Divisible n r'@(Yearly _) -> handlediv n r' ynum Nothing
Divisible _ r'@(Divisible _ _) -> findfrom r' afterday candidate
where
- skip n = findfrom r False (addDays n candidate)
- handlediv n r' getval mmax
+ skip n = findfrom r False (addDays n candidate)
+ handlediv n r' getval mmax
| n > 0 && maybe True (n <=) mmax =
findfromwhere r' (divisible n . getval) afterday candidate
| otherwise = Nothing
@@ -267,7 +267,7 @@ toRecurrance s = case words s of
constructor u
| "s" `isSuffixOf` u = constructor $ reverse $ drop 1 $ reverse u
| otherwise = Nothing
- withday sd u = do
+ withday sd u = do
c <- constructor u
d <- readish sd
Just $ c (Just d)
@@ -285,7 +285,7 @@ fromScheduledTime AnyTime = "any time"
fromScheduledTime (SpecificTime h m) =
show h' ++ (if m > 0 then ":" ++ pad 2 (show m) else "") ++ " " ++ ampm
where
- pad n s = take (n - length s) (repeat '0') ++ s
+ pad n s = replicate (n - length s) '0' ++ s
(h', ampm)
| h == 0 = (12, "AM")
| h < 12 = (h, "AM")
@@ -304,10 +304,10 @@ toScheduledTime v = case words v of
(s:[]) -> go s id
_ -> Nothing
where
- h0 h
+ h0 h
| h == 12 = 0
| otherwise = h
- go :: String -> (Int -> Int) -> Maybe ScheduledTime
+ go :: String -> (Int -> Int) -> Maybe ScheduledTime
go s adjust =
let (h, m) = separate (== ':') s
in SpecificTime
@@ -336,41 +336,6 @@ parseSchedule s = do
recurrance = unwords rws
scheduledtime = unwords tws
-instance Arbitrary Schedule where
- arbitrary = Schedule <$> arbitrary <*> arbitrary
-
-instance Arbitrary ScheduledTime where
- arbitrary = oneof
- [ pure AnyTime
- , SpecificTime
- <$> choose (0, 23)
- <*> choose (1, 59)
- ]
-
-instance Arbitrary Recurrance where
- arbitrary = oneof
- [ pure Daily
- , Weekly <$> arbday
- , Monthly <$> arbday
- , Yearly <$> arbday
- , Divisible
- <$> positive arbitrary
- <*> oneof -- no nested Divisibles
- [ pure Daily
- , Weekly <$> arbday
- , Monthly <$> arbday
- , Yearly <$> arbday
- ]
- ]
- where
- arbday = oneof
- [ Just <$> nonNegative arbitrary
- , pure Nothing
- ]
-
-prop_schedule_roundtrips :: Schedule -> Bool
-prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s
-
prop_past_sane :: Bool
prop_past_sane = and
[ all (checksout oneMonthPast) (mplus1 ++ yplus1)
diff --git a/src/Utility/SystemDirectory.hs b/src/Utility/SystemDirectory.hs
new file mode 100644
index 00000000..3dd44d19
--- /dev/null
+++ b/src/Utility/SystemDirectory.hs
@@ -0,0 +1,16 @@
+{- System.Directory without its conflicting isSymbolicLink
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+-- Disable warnings because only some versions of System.Directory export
+-- isSymbolicLink.
+{-# OPTIONS_GHC -fno-warn-tabs -w #-}
+
+module Utility.SystemDirectory (
+ module System.Directory
+) where
+
+import System.Directory hiding (isSymbolicLink)
diff --git a/src/Utility/Table.hs b/src/Utility/Table.hs
index 910038e8..6d4c045b 100644
--- a/src/Utility/Table.hs
+++ b/src/Utility/Table.hs
@@ -1,6 +1,6 @@
{- text based table generation
-
- - Copyright 2014 Joey Hess <joey@kitenet.net>
+ - Copyright 2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@@ -16,13 +16,14 @@ tableWithHeader header rows = header : map linesep header : rows
where
linesep = map (const '-')
--- | Formats a table to lines, automatically padding rows to the same size.
+-- | Formats a table to lines, automatically padding columns to the same size.
formatTable :: Table -> [String]
-formatTable table = map (\r -> unwords (map pad (zip r rowsizes))) table
+formatTable table = map (\r -> unwords (map pad (zip r colsizes))) table
where
pad (cell, size) = cell ++ take (size - length cell) padding
padding = repeat ' '
- rowsizes = sumrows (map (map length) table)
- sumrows [] = repeat 0
- sumrows [r] = r
- sumrows (r1:r2:rs) = sumrows $ map (uncurry max) (zip r1 r2) : rs
+ colsizes = reverse $ (0:) $ drop 1 $ reverse $
+ sumcols (map (map length) table)
+ sumcols [] = repeat 0
+ sumcols [r] = r
+ sumcols (r1:r2:rs) = sumcols $ zipWith max r1 r2 : rs
diff --git a/src/Utility/ThreadScheduler.hs b/src/Utility/ThreadScheduler.hs
index fc026d7e..da05e996 100644
--- a/src/Utility/ThreadScheduler.hs
+++ b/src/Utility/ThreadScheduler.hs
@@ -1,6 +1,6 @@
{- thread scheduling
-
- - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2012, 2013 Joey Hess <id@joeyh.name>
- Copyright 2011 Bas van Dijk & Roel van Dijk
-
- License: BSD-2-clause
@@ -57,8 +57,7 @@ unboundDelay time = do
waitForTermination :: IO ()
waitForTermination = do
#ifdef mingw32_HOST_OS
- runEvery (Seconds 600) $
- void getLine
+ forever $ threadDelaySeconds (Seconds 6000)
#else
lock <- newEmptyMVar
let check sig = void $
diff --git a/src/Utility/Tmp.hs b/src/Utility/Tmp.hs
index 0dc9f2c0..6a541cfe 100644
--- a/src/Utility/Tmp.hs
+++ b/src/Utility/Tmp.hs
@@ -1,19 +1,23 @@
{- Temporary files and directories.
-
- - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2013 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Tmp where
-import Control.Exception (bracket)
import System.IO
-import System.Directory
import Control.Monad.IfElse
import System.FilePath
+import System.Directory
+import Control.Monad.IO.Class
+#ifndef mingw32_HOST_OS
+import System.Posix.Temp (mkdtemp)
+#endif
import Utility.Exception
import Utility.FileSystemEncoding
@@ -24,64 +28,84 @@ type Template = String
{- Runs an action like writeFile, writing to a temp file first and
- then moving it into place. The temp file is stored in the same
- directory as the final file to avoid cross-device renames. -}
-viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()
-viaTmp a file content = do
- let (dir, base) = splitFileName file
- createDirectoryIfMissing True dir
- (tmpfile, handle) <- openTempFile dir (base ++ ".tmp")
- hClose handle
- a tmpfile content
- rename tmpfile file
+viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> String -> m ()) -> FilePath -> String -> m ()
+viaTmp a file content = bracketIO setup cleanup use
+ where
+ (dir, base) = splitFileName file
+ template = base ++ ".tmp"
+ setup = do
+ createDirectoryIfMissing True dir
+ openTempFile dir template
+ cleanup (tmpfile, h) = do
+ _ <- tryIO $ hClose h
+ tryIO $ removeFile tmpfile
+ use (tmpfile, h) = do
+ liftIO $ hClose h
+ a tmpfile content
+ liftIO $ rename tmpfile file
{- Runs an action with a tmp file located in the system's tmp directory
- (or in "." if there is none) then removes the file. -}
-withTmpFile :: Template -> (FilePath -> Handle -> IO a) -> IO a
+withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a
withTmpFile template a = do
- tmpdir <- catchDefaultIO "." getTemporaryDirectory
+ tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
withTmpFileIn tmpdir template a
{- Runs an action with a tmp file located in the specified directory,
- then removes the file. -}
-withTmpFileIn :: FilePath -> Template -> (FilePath -> Handle -> IO a) -> IO a
+withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a
withTmpFileIn tmpdir template a = bracket create remove use
where
- create = openTempFile tmpdir template
- remove (name, handle) = do
- hClose handle
+ create = liftIO $ openTempFile tmpdir template
+ remove (name, h) = liftIO $ do
+ hClose h
catchBoolIO (removeFile name >> return True)
- use (name, handle) = a name handle
+ use (name, h) = a name h
{- Runs an action with a tmp directory located within the system's tmp
- directory (or within "." if there is none), then removes the tmp
- directory and all its contents. -}
-withTmpDir :: Template -> (FilePath -> IO a) -> IO a
+withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
withTmpDir template a = do
- tmpdir <- catchDefaultIO "." getTemporaryDirectory
- withTmpDirIn tmpdir template a
+ topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
+#ifndef mingw32_HOST_OS
+ -- Use mkdtemp to create a temp directory securely in /tmp.
+ bracket
+ (liftIO $ mkdtemp $ topleveltmpdir </> template)
+ removeTmpDir
+ a
+#else
+ withTmpDirIn topleveltmpdir template a
+#endif
{- Runs an action with a tmp directory located within a specified directory,
- then removes the tmp directory and all its contents. -}
-withTmpDirIn :: FilePath -> Template -> (FilePath -> IO a) -> IO a
-withTmpDirIn tmpdir template = bracket create remove
+withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
+withTmpDirIn tmpdir template = bracketIO create removeTmpDir
where
- remove d = whenM (doesDirectoryExist d) $ do
-#if mingw32_HOST_OS
- -- Windows will often refuse to delete a file
- -- after a process has just written to it and exited.
- -- Because it's crap, presumably. So, ignore failure
- -- to delete the temp directory.
- _ <- tryIO $ removeDirectoryRecursive d
- return ()
-#else
- removeDirectoryRecursive d
-#endif
create = do
createDirectoryIfMissing True tmpdir
makenewdir (tmpdir </> template) (0 :: Int)
makenewdir t n = do
let dir = t ++ "." ++ show n
- either (const $ makenewdir t $ n + 1) (const $ return dir)
- =<< tryIO (createDirectory dir)
+ catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
+ createDirectory dir
+ return dir
+
+{- Deletes the entire contents of the the temporary directory, if it
+ - exists. -}
+removeTmpDir :: MonadIO m => FilePath -> m ()
+removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
+#if mingw32_HOST_OS
+ -- Windows will often refuse to delete a file
+ -- after a process has just written to it and exited.
+ -- Because it's crap, presumably. So, ignore failure
+ -- to delete the temp directory.
+ _ <- tryIO $ removeDirectoryRecursive tmpdir
+ return ()
+#else
+ removeDirectoryRecursive tmpdir
+#endif
{- It's not safe to use a FilePath of an existing file as the template
- for openTempFile, because if the FilePath is really long, the tmpfile
diff --git a/src/Utility/UserInfo.hs b/src/Utility/UserInfo.hs
index 617c3e94..c6010116 100644
--- a/src/Utility/UserInfo.hs
+++ b/src/Utility/UserInfo.hs
@@ -1,11 +1,12 @@
{- user info
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.UserInfo (
myHomeDir,
@@ -13,11 +14,12 @@ module Utility.UserInfo (
myUserGecos,
) where
-import Control.Applicative
-import System.PosixCompat
-
import Utility.Env
+import System.PosixCompat
+import Control.Applicative
+import Prelude
+
{- Current user's home directory.
-
- getpwent will fail on LDAP or NIS, so use HOME if set. -}
@@ -40,16 +42,20 @@ myUserName = myVal env userName
env = ["USERNAME", "USER", "LOGNAME"]
#endif
-myUserGecos :: IO String
-#ifdef __ANDROID__
-myUserGecos = return "" -- userGecos crashes on Android
+myUserGecos :: IO (Maybe String)
+-- userGecos crashes on Android and is not available on Windows.
+#if defined(__ANDROID__) || defined(mingw32_HOST_OS)
+myUserGecos = return Nothing
#else
-myUserGecos = myVal [] userGecos
+myUserGecos = Just <$> myVal [] userGecos
#endif
myVal :: [String] -> (UserEntry -> String) -> IO String
-myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars
+myVal envvars extract = go envvars
where
- check [] = return Nothing
- check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v
- getpwent = getUserEntryForID =<< getEffectiveUserID
+#ifndef mingw32_HOST_OS
+ go [] = extract <$> (getUserEntryForID =<< getEffectiveUserID)
+#else
+ go [] = extract <$> error ("environment not set: " ++ show envvars)
+#endif
+ go (v:vs) = maybe (go vs) return =<< getEnv v
diff --git a/src/wrapper.hs b/src/wrapper.hs
index 304e833d..dab77358 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -3,164 +3,42 @@
-- Distributions should install this program into PATH.
-- (Cabal builds it as dist/build/propellor/propellor).
--
--- This is not the propellor main program (that's config.hs)
---
--- This installs propellor's source into ~/.propellor,
--- uses it to build the real propellor program (if not already built),
--- and runs it.
---
--- The source is cloned from /usr/src/propellor when available,
--- or is cloned from git over the network.
+-- This is not the propellor main program (that's config.hs).
+-- This bootstraps ~/.propellor/config.hs, builds it if
+-- it's not already built, and runs it.
module Main where
+import Propellor.DotDir
import Propellor.Message
-import Utility.UserInfo
+import Propellor.Bootstrap
import Utility.Monad
+import Utility.Directory
import Utility.Process
-import Utility.SafeCommand
-import Utility.Exception
+import Utility.Process.NonConcurrent
-import Control.Monad
-import Control.Monad.IfElse
-import Control.Applicative
-import System.Directory
-import System.FilePath
import System.Environment (getArgs)
import System.Exit
import System.Posix.Directory
-import System.IO
-
-distdir :: FilePath
-distdir = "/usr/src/propellor"
-
-distrepo :: FilePath
-distrepo = distdir </> "propellor.git"
-
-disthead :: FilePath
-disthead = distdir </> "head"
-
-upstreambranch :: String
-upstreambranch = "upstream/master"
-
--- Using the github mirror of the main propellor repo because
--- it is accessible over https for better security.
-netrepo :: String
-netrepo = "https://github.com/joeyh/propellor.git"
+import Control.Monad.IfElse
main :: IO ()
-main = do
- args <- getArgs
- home <- myHomeDir
- let propellordir = home </> ".propellor"
- let propellorbin = propellordir </> "propellor"
- wrapper args propellordir propellorbin
-
-wrapper :: [String] -> FilePath -> FilePath -> IO ()
-wrapper args propellordir propellorbin = do
- ifM (doesDirectoryExist propellordir)
- ( checkRepo
- , makeRepo
- )
- buildruncfg
+main = withConcurrentOutput $ go =<< getArgs
where
- makeRepo = do
- putStrLn $ "Setting up your propellor repo in " ++ propellordir
- putStrLn ""
- ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
- ( do
- void $ boolSystem "git" [Param "clone", File distrepo, File propellordir]
- fetchUpstreamBranch propellordir distrepo
- changeWorkingDirectory propellordir
- void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"]
- , void $ boolSystem "git" [Param "clone", Param netrepo, File propellordir]
- )
-
- checkRepo = whenM (doesFileExist disthead) $ do
- headrev <- takeWhile (/= '\n') <$> readFile disthead
- changeWorkingDirectory propellordir
- headknown <- catchMaybeIO $
- withQuietOutput createProcessSuccess $
- proc "git" ["log", headrev]
- if (headknown == Nothing)
- then setupupstreammaster headrev propellordir
- else do
- merged <- not . null <$>
- readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
- unless merged $
- warnoutofdate propellordir True
- buildruncfg = do
- changeWorkingDirectory propellordir
- ifM (boolSystem "make" [Param "build"])
- ( do
- putStrLn ""
- putStrLn ""
- chain
- , error "Propellor build failed."
- )
- chain = do
- (_, _, _, pid) <- createProcess (proc propellorbin args)
- exitWith =<< waitForProcess pid
-
--- Passed the user's propellordir repository, makes upstream/master
--- be a usefully mergeable branch.
---
--- We cannot just use origin/master, because in the case of a distrepo,
--- it only contains 1 commit. So, trying to merge with it will result
--- in lots of merge conflicts, since git cannot find a common parent
--- commit.
---
--- Instead, the upstream/master branch is created by taking the
--- upstream/master branch (which must be an old version of propellor,
--- as distributed), and diffing from it to the current origin/master,
--- and committing the result. This is done in a temporary clone of the
--- repository, giving it a new master branch. That new branch is fetched
--- into the user's repository, as if fetching from a upstream remote,
--- yielding a new upstream/master branch.
-setupupstreammaster :: String -> FilePath -> IO ()
-setupupstreammaster newref propellordir = do
- changeWorkingDirectory propellordir
- go =<< catchMaybeIO getoldrev
- where
- go Nothing = warnoutofdate propellordir False
- go (Just oldref) = do
- let tmprepo = ".git/propellordisttmp"
- let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
- cleantmprepo
- git ["clone", "--quiet", ".", tmprepo]
-
- changeWorkingDirectory tmprepo
- git ["fetch", distrepo, "--quiet"]
- git ["reset", "--hard", oldref, "--quiet"]
- git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
-
- fetchUpstreamBranch propellordir tmprepo
- cleantmprepo
- warnoutofdate propellordir True
-
- getoldrev = takeWhile (/= '\n')
- <$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
-
- git = run "git"
- run cmd ps = unlessM (boolSystem cmd (map Param ps)) $
- error $ "Failed to run " ++ cmd ++ " " ++ show ps
-
-warnoutofdate :: FilePath -> Bool -> IO ()
-warnoutofdate propellordir havebranch = do
- warningMessage ("** Your " ++ propellordir ++ " is out of date..")
- let also s = hPutStrLn stderr (" " ++ s)
- also ("A newer upstream version is available in " ++ distrepo)
- if havebranch
- then also ("To merge it, run: git merge " ++ upstreambranch)
- else also ("To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again.")
- also ""
+ go ["--init"] = interactiveInit
+ go args = ifM (doesDirectoryExist =<< dotPropellor)
+ ( do
+ checkRepoUpToDate
+ buildRunConfig args
+ , error "Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init"
+ )
-fetchUpstreamBranch :: FilePath -> FilePath -> IO ()
-fetchUpstreamBranch propellordir repo = do
- changeWorkingDirectory propellordir
- void $ boolSystem "git"
- [ Param "fetch"
- , File repo
- , Param ("+refs/heads/master:refs/remotes/" ++ upstreambranch)
- , Param "--quiet"
- ]
+buildRunConfig :: [String] -> IO ()
+buildRunConfig args = do
+ changeWorkingDirectory =<< dotPropellor
+ unlessM (doesFileExist "propellor") $ do
+ buildPropellor Nothing
+ putStrLn ""
+ putStrLn ""
+ (_, _, _, pid) <- createProcessNonConcurrent (proc "./propellor" args)
+ exitWith =<< waitForProcessNonConcurrent pid
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 00000000..7b6bcef8
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,3 @@
+resolver: lts-5.10
+packages:
+- '.'