add APT:MIRROR and APT:STANDARD-SOURCES.LIST

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

4 files changed, 50 insertions, 4 deletions

diff --git a/src/package.lisp b/src/package.lisp
index 6976d07..f086c4c 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -51,6 +51,7 @@
 	   #:unlines
 	   #:noop
 	   #:symbol-named
+	   #:stringmem
 
 	   #:version<
 	   #:version>
@@ -95,6 +96,7 @@
 	   #:get-hostname
 	   #:require-data
 	   #:failed-change
+	   #:call-with-os
 
 	   ;; propspec.lisp
 	   #:in-consfig
@@ -203,14 +205,18 @@
 	   #:debian
 	   #:debian-stable
 	   #:debian-testing
-	   #:debian-unstable))
+	   #:debian-unstable
+	   #:debian-suite))
 
 (defpackage :consfigurator.property.apt
   (:use #:cl #:alexandria #:consfigurator)
   (:local-nicknames (#:re  #:cl-ppcre)
-		    (#:os  #:consfigurator.property.os))
+		    (#:file  #:consfigurator.property.file)
+		    (#:os    #:consfigurator.property.os))
   (:export #:installed
-	   #:removed))
+	   #:removed
+	   #:mirror
+	   #:standard-sources.list))
 
 (defpackage :consfigurator.data.asdf
   (:use #:cl #:consfigurator))
diff --git a/src/property.lisp b/src/property.lisp
index 9ee9393..a4ae9a0 100644
--- a/src/property.lisp
+++ b/src/property.lisp
@@ -274,3 +274,6 @@ Called by property subroutines."
   ((text :initarg :text :reader failed-change-text))
   (:report (lambda (condition stream)
 	     (format stream "~A" (failed-change-text condition)))))
+
+(defun call-with-os (f &rest args)
+  (apply (ensure-function f) (get-hostattrs-car :os) args))
diff --git a/src/property/apt.lisp b/src/property/apt.lisp
index de5ffc2..0942c5e 100644
--- a/src/property/apt.lisp
+++ b/src/property/apt.lisp
@@ -19,7 +19,7 @@
 (named-readtables:in-readtable :interpol-syntax)
 
 
-;;;; Macros
+;;;; Static definitions
 
 (defmacro with-maybe-update (form)
   `(handler-case ,form
@@ -27,6 +27,8 @@
        (apt-get :princ "update")
        ,form)))
 
+(define-constant sections '("main" "contrib" "non-free") :test #'equal)
+
 
 ;;;; Properties
 
@@ -52,6 +54,37 @@
   (:apply
    (apt-get :princ "-y" "remove" packages)))
 
+(defprop mirror :posix (uri)
+  (:desc #?"${uri} apt mirror selected")
+  (:hostattrs
+   (pushnew-hostattrs :apt.mirror uri)))
+
+(defun get-mirrors ()
+  (or (get-hostattrs :apt.mirror) (call-with-os #'get-default-mirrors)))
+
+(defmethod get-default-mirrors ((os os:debian))
+  '("http://deb.debian.org/debian"))
+
+(defprop standard-sources.list :posix ()
+  (:desc "Standard sources.list")
+  (:apply
+   (file:has-content "/etc/apt/sources.list"
+     (call-with-os #'standard-sources-for))))
+
+(defmethod standard-sources-for ((os os:debian))
+  (let* ((suite (os:debian-suite os))
+	 (archive (mapcar (lambda (m) (cons m (cons suite sections)))
+			  (get-mirrors)))
+	 (security-suite (if (stringmem suite '("stretch" "jessie" "buster"))
+			     #?"${suite}/updates"
+			     #?"${suite}-security"))
+	 (security (and (not (subtypep (type-of os) 'os:debian-unstable))
+			(list
+			 (cons "http://security.debian.org/debian-security"
+			       (cons security-suite sections))))))
+    (mapcan (lambda (l) (list #?"deb @{l}" #?"deb-src @{l}"))
+	    (nconc archive security))))
+
 
 ;;;; Reports on installation status
 
diff --git a/src/util.lisp b/src/util.lisp
index de49b5e..daa0b37 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -37,6 +37,10 @@
     (string system)
     (symbol (string-downcase
 	     (symbol-name system)))))
+
+(defun stringmem (string list)
+  (member string list :test #'string=))
+
 
 ;;;; Version numbers