bug#22274: GuixSD resets hardware clock (on Lenovo x200 with libreboot)

[Christopher Allan Webber <cwebber@dustycloud.org>]

[-- Attachment #1: Type: text/plain, Size: 874 bytes --]

Christopher Allan Webber writes:

>>> When I'm not on a train I can try building the "current" system with
>>> Linux-Libre 4.2.5 and see if it's really the kernel.
>>
>> Yes, that would be helpful!  It would be nice to check with other X200
>> users too.
>>
>> Thanks for investigating!
>>
>> Ludo’.
>
> Okay, I'll try all these things as soon as I'm not tethering from a
> phone :)

Well it took me a bit longer than I said, but I finally tried it :)

My config is attached.  Hackily, I copy-pasta'ed the kernel packages
entirely from guix v0.9.0's release.  I can confirm that this can read
the hardware clock just fine, whereas the other version of the kernel
can't... so it does indeed look like between Linux-Libre 4.2.5 and
Linux-Libre 4.3.3 we have some sort of regression that leads to this
problem on x200 Minifree Libreboot-enabled laptops, at least.

 - Chris


[-- Attachment #2: config-new-with-old-kernel.scm --]
[-- Type: application/octet-stream, Size: 11585 bytes --]

;; This is an operating system configuration template
;; for a "desktop" setup with X11.

(use-modules (gnu) (gnu system nss)
             ;; dump in the stuff from (gnu packages linux)
             ((guix licenses)
              #:hide (zlib))
             (gnu packages)
             (gnu packages compression)
             (gnu packages gcc)
             (gnu packages flex)
             (gnu packages bison)
             (gnu packages admin)
             (gnu packages gperf)
             (gnu packages libusb)
             (gnu packages ncurses)
             (gnu packages pciutils)
             (gnu packages databases)
             (gnu packages perl)
             (gnu packages pkg-config)
             (gnu packages python)
             (gnu packages slang)
             (gnu packages algebra)
             (gnu packages gettext)
             (gnu packages glib)
             (gnu packages pulseaudio)
             (gnu packages attr)
             (gnu packages xml)
             (gnu packages autotools)
             (gnu packages texinfo)
             (gnu packages check)
             (gnu packages maths)
             (gnu packages base)
             (gnu packages rrdtool)
             (gnu packages elf)
             (gnu packages gtk)
             (gnu packages docbook)
             (gnu packages asciidoc)
             (gnu packages readline)
             (gnu packages calendar)
             (guix packages)
             (guix download)
             (guix utils)
             (guix build-system gnu)
             (guix build-system cmake)
             (guix build-system python)
             (guix build-system trivial)
             (srfi srfi-26)
             (ice-9 match))
(use-service-modules desktop)
(use-package-modules xfce ratpoison certs)

(define-public (system->linux-architecture arch)
  "Return the Linux architecture name for ARCH, a Guix system name such as
\"x86_64-linux\"."
  (let ((arch (car (string-split arch #\-))))
    (cond ((string=? arch "i686") "i386")
          ((string-prefix? "mips" arch) "mips")
          ((string-prefix? "arm" arch) "arm")
          (else arch))))

(define (linux-libre-urls version)
  "Return a list of URLs for Linux-Libre VERSION."
  (list (string-append
         "http://linux-libre.fsfla.org/pub/linux-libre/releases/"
         version "-gnu/linux-libre-" version "-gnu.tar.xz")

        ;; XXX: Work around <http://bugs.gnu.org/14851>.
        (string-append
         "ftp://alpha.gnu.org/gnu/guix/mirror/linux-libre-"
         version "-gnu.tar.xz")

        ;; Maybe this URL will become valid eventually.
        (string-append
         "mirror://gnu/linux-libre/" version "-gnu/linux-libre-"
         version "-gnu.tar.xz")))


(define-public module-init-tools
  (package
    (name "module-init-tools")
    (version "3.16")
    (source (origin
             (method url-fetch)
             (uri (string-append
                   "mirror://kernel.org/linux/utils/kernel/module-init-tools/module-init-tools-"
                   version ".tar.bz2"))
             (sha256
              (base32
               "0jxnz9ahfic79rp93l5wxcbgh4pkv85mwnjlbv1gz3jawv5cvwp1"))
             (patches
              (list (search-patch "module-init-tools-moduledir.patch")))))
    (build-system gnu-build-system)
    (arguments
     ;; FIXME: The upstream tarball lacks man pages, and building them would
     ;; require DocBook & co.  We used to use Gentoo's pre-built man pages,
     ;; but they vanished.  In the meantime, fake it.
     '(#:phases (alist-cons-before
                 'configure 'fake-docbook
                 (lambda _
                   (substitute* "Makefile.in"
                     (("^DOCBOOKTOMAN.*$")
                      "DOCBOOKTOMAN = true\n")))
                 %standard-phases)))
    (home-page "http://www.kernel.org/pub/linux/utils/kernel/module-init-tools/")
    (synopsis "Tools for loading and managing Linux kernel modules")
    (description
     "Tools for loading and managing Linux kernel modules, such as `modprobe',
`insmod', `lsmod', and more.")
    (license gpl2+)))

(define %boot-logo-patch
  ;; Linux-Libre boot logo featuring Freedo and a gnu.
  (origin
    (method url-fetch)
    (uri (string-append "http://www.fsfla.org/svn/fsfla/software/linux-libre/"
                        "lemote/gnewsense/branches/3.16/100gnu+freedo.patch"))
    (sha256
     (base32
      "1hk9swxxc80bmn2zd2qr5ccrjrk28xkypwhl4z0qx4hbivj7qm06"))))

(define (kernel-config system)
  "Return the absolute file name of the Linux-Libre build configuration file
for SYSTEM, or #f if there is no configuration for SYSTEM."
  (define (lookup file)
    (let ((file (string-append "gnu/packages/" file)))
      (search-path %load-path file)))

  (match system
    ("i686-linux"
     (lookup "linux-libre-i686.conf"))
    ("x86_64-linux"
     (lookup "linux-libre-x86_64.conf"))
    (_
     #f)))



(define-public linux-libre
  (let* ((version "4.2.5")
         (build-phase
          '(lambda* (#:key system inputs #:allow-other-keys #:rest args)
             ;; Apply the neat patch.
             (system* "patch" "-p1" "--force"
                      "-i" (assoc-ref inputs "patch/freedo+gnu"))

             (let ((arch (car (string-split system #\-))))
               (setenv "ARCH"
                       (cond ((string=? arch "i686") "i386")
                             ((string=? arch "mips64el") "mips")
                             (else arch)))
               (format #t "`ARCH' set to `~a'~%" (getenv "ARCH")))

             (let ((build  (assoc-ref %standard-phases 'build))
                   (config (assoc-ref inputs "kconfig")))

               ;; Use the architecture-specific config if available, and
               ;; 'defconfig' otherwise.
               (if config
                   (begin
                     (copy-file config ".config")
                     (chmod ".config" #o666))
                   (system* "make" "defconfig"))

               ;; Appending works even when the option wasn't in the
               ;; file.  The last one prevails if duplicated.
               (let ((port (open-file ".config" "a")))
                 (display (string-append "CONFIG_NET_9P=m\n"
                                         "CONFIG_NET_9P_VIRTIO=m\n"
                                         "CONFIG_VIRTIO_BLK=m\n"
                                         "CONFIG_VIRTIO_NET=m\n"
                                         ;; https://lists.gnu.org/archive/html/guix-devel/2014-04/msg00039.html
                                         "CONFIG_DEVPTS_MULTIPLE_INSTANCES=y\n"
                                         "CONFIG_VIRTIO_PCI=m\n"
                                         "CONFIG_VIRTIO_BALLOON=m\n"
                                         "CONFIG_VIRTIO_MMIO=m\n"
                                         "CONFIG_FUSE_FS=m\n"
                                         "CONFIG_CIFS=m\n"
                                         "CONFIG_9P_FS=m\n")
                          port)
                 (close-port port))

               (zero? (system* "make" "oldconfig"))

               ;; Call the default `build' phase so `-j' is correctly
               ;; passed.
               (apply build #:make-flags "all" args))))
         (install-phase
          `(lambda* (#:key inputs outputs #:allow-other-keys)
             (let* ((out    (assoc-ref outputs "out"))
                    (moddir (string-append out "/lib/modules"))
                    (mit    (assoc-ref inputs "module-init-tools")))
               (mkdir-p moddir)
               (for-each (lambda (file)
                           (copy-file file
                                      (string-append out "/" (basename file))))
                         (find-files "." "^(bzImage|vmlinuz|System\\.map)$"))
               (copy-file ".config" (string-append out "/config"))
               (zero? (system* "make"
                               (string-append "DEPMOD=" mit "/sbin/depmod")
                               (string-append "MODULE_DIR=" moddir)
                               (string-append "INSTALL_PATH=" out)
                               (string-append "INSTALL_MOD_PATH=" out)
                               "INSTALL_MOD_STRIP=1"
                               "modules_install"))))))
   (package
    (name "linux-libre")
    (version version)
    (source (origin
             (method url-fetch)
             (uri (linux-libre-urls version))
             (sha256
              (base32
               "13ar9sghm2g5w2km9x2d07q3lh81rz286d6slklv56qanm24chzx"))))
    (build-system gnu-build-system)
    (supported-systems '("x86_64-linux" "i686-linux"))
    (native-inputs `(("perl" ,perl)
                     ("bc" ,bc)
                     ("module-init-tools" ,module-init-tools)
                     ("patch/freedo+gnu" ,%boot-logo-patch)

                     ,@(let ((conf (kernel-config (or (%current-target-system)
                                                      (%current-system)))))
                         (if conf
                             `(("kconfig" ,conf))
                             '()))))
    (arguments
     `(#:modules ((guix build gnu-build-system)
                  (guix build utils)
                  (srfi srfi-1)
                  (ice-9 match))
       #:phases (alist-replace
                 'build ,build-phase
                 (alist-replace
                  'install ,install-phase
                  (alist-delete 'configure %standard-phases)))
       #:tests? #f))
    (synopsis "100% free redistribution of a cleaned Linux kernel")
    (description
     "GNU Linux-Libre is a free (as in freedom) variant of the Linux kernel.
It has been modified to remove all non-free binary blobs.")
    (license gpl2)
    (home-page "http://www.gnu.org/software/linux-libre/"))))


(operating-system
  (host-name "oolong")
  (timezone "America/Chicago")
  (locale "en_US.UTF-8")

  (kernel linux-libre)

  ;; Assuming /dev/sdX is the target hard disk, and "root" is
  ;; the label of the target root file system.
  (bootloader (grub-configuration
	       (device "/dev/sda")))
  (mapped-devices (list (mapped-device
			 (source "/dev/sda8")
			 (target "home-luks")
			 (type luks-device-mapping))))
  (file-systems `(,(file-system
                        (device "guix")
                        (title 'label)
                        (mount-point "/")
                        (type "ext4"))
                  ,(file-system
                     (device "/dev/mapper/home-luks")
                     (mount-point "/home")
                     (type "ext4"))
                  ,@%base-file-systems))

  (users (cons (user-account
                (name "cwebber")
		(uid 1000)
                (comment "Christopher Allan Webber")
                (group "cwebber")
                (supplementary-groups '("users"
					"wheel" "netdev"
                                        "audio" "video"))
                (home-directory "/home/cwebber"))
               %base-user-accounts))

  (groups (cons (user-group
		 (name "cwebber")
		 (id 1000))
		%base-groups))

  ;; Add Xfce and Ratpoison; that allows us to choose
  ;; sessions using either of these at the log-in screen.
  (packages (cons* xfce ratpoison    ;desktop environments
                   nss-certs         ;for HTTPS access
                   %base-packages))

  ;; Use the "desktop" services, which include the X11
  ;; log-in service, networking with Wicd, and more.
  (services %desktop-services)

  ;; Allow resolution of '.local' host names with mDNS.
  (name-service-switch %mdns-host-lookup-nss))