<commit_before>{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

module Main where

import qualified Data.Yaml.Config as YConf
import System.Environment
import System.Directory
import System.Exit

import qualified Data.Text as T
import Network.Mail.Mime.SES
import qualified Data.Text.Encoding as DTE
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as LBS
import Network.HTTP.Conduit
import Control.Monad
import Data.Monoid
import Data.Maybe
import Data.String

import Data.Conduit
import System.Cmd
import Data.Time
import System.Locale (defaultTimeLocale)
import qualified Data.Time.Format as DTF

import System.Process
import System.Cmd
import System.IO
import System.Exit
import qualified Control.Exception as C
import Control.Exception
import Control.DeepSeq (rnf)
import Control.Concurrent


confPath = "/etc/debcd/debcd.yml"

main = do
  conf <- getConfig
  sender <- getSender conf

  update conf sender

update conf sender = do

  let upRepos = YConf.lookupDefault "update-repos" ("all"::String) conf

      updateCmd 
         = case upRepos of
             "all"  -> "apt-get update"
             "none" -> "echo Nothing to do"
             repo   -> "apt-get update -o Dir::Etc::sourcelist=\"sources.list.d/"++
                               repo++".list\"-o Dir::Etc::sourceparts=\"-\" "++
                               "-o APT::Get::List-Cleanup=\"0\""

  updateRes <- psh updateCmd
  case updateRes of
    Left err -> sender $ ["debcd: error updating APT", 
                          "\nError:\n ", err]
    Right _ -> do
        upgradesAvailable <- fmap ((/=) ExitSuccess) 
                                  $ system "apt-get -u upgrade --assume-no"                               
        when upgradesAvailable $ upgrade sender

upgrade sender = do

 selections <- createFreezeList
 putStrLn "upgrading.."
 upgRes <- system "DEBIAN_FRONTEND=noninteractive apt-get upgrade -y"
 putStrLn "..done upgrading"
 case upgRes of
   ExitFailure err -> sender $ ["debcd: error upgrading packages", 
                          "\nError:\n ", show err]
   ExitSuccess -> do

       -- run tests
       testsOK <- runTests sender

       -- roll back on failure
       when (not testsOK) $ rollback selections

       return ()

-- these two based on http://www.debian-administration.org/article/669/

runTests sender = do
  files <- getDirectoryContents "/etc/debcd/tests.d/"
  testRess <-  forM files $ \file -> do
    p <- getPermissions $ "/etc/debcd/tests.d/"++file
    if not $ executable p
       then return Nothing
       else do debug $ "running test "++ file
               res <- psh $ "/etc/debcd/tests.d/"++file
               case res of 
                 Right _ -> return Nothing
                 Left err -> return $ Just $ "Test: "++file++"\nOutput:\n"++ 
                                               (unlines $ map ("  "++) $ lines err)
  if all isNothing testRess
     then return True
     else do sender ("debcd: Test failure":catMaybes testRess)
             return False

createFreezeList :: IO String
createFreezeList = do
 now <- getCurrentTime
 let nowS =  DTF.formatTime defaultTimeLocale "%Y%m%d%H%M" now
 system "mkdir -p /var/debcd"
 system $ "aptitude -q -F \"%?p=%?V %M\" --disable-columns search \\~i > /var/debcd/"
          ++nowS
 return nowS

rollback :: String -> IO ()
rollback list = void $ do
  system $ "aptitude -q -R --schedule-only install $(awk < /var/debcd/"++
           list++" '{print $1}')"
  system $ "aptitude -q -R --schedule-only markauto $(awk < /var/debcd/"++
           list++" '$2==\"A\" {split($1,A,\"=\");print A[1]}')"
  system $ "aptitude -y -o Dpkg::Options::=\"--force-confdef\" install"

getConfig :: IO YConf.Config
getConfig = do
 allConfig <- YConf.load confPath
 args <- getArgs
 let envNm = case (args, YConf.keys allConfig) of
            (env:_, _) -> T.pack env
            ([], []) -> error $ "debcd: unable to determine a configuration "++
                                "environment from "++confPath
            ([] , env:_) -> env
 case YConf.subconfig envNm allConfig of
           Nothing -> fail $ "Cannot find configuration environment "++
                             T.unpack envNm++" in "++confPath
           Just c -> return c

getSender :: YConf.Config -> IO ([String] -> IO ())
getSender conf = 
  let mses = do emailTo <- YConf.lookup "emailTo" conf
                emailFrom <- YConf.lookup "emailTo" conf
                access <-  YConf.lookup "aws_access" conf
                secret <-  YConf.lookup "aws_secret" conf
                return $ SES
                   { sesFrom = S8.pack $ emailFrom
                   , sesTo = [DTE.encodeUtf8 emailTo]
                   , sesAccessKey = S8.pack $ access
                   , sesSecretKey = S8.pack $ secret
                   }
  in case mses of
       Nothing -> return $ putStrLn . unlines 
       Just ses -> do man <- newManager conduitManagerSettings
                      return $  \ss -> do
                          runResourceT . sendMailSES man ses . fromString . unlines $ ss
                          putStrLn $ unlines ss
                          putStrLn "(sent email)"             

psh :: String -> IO (Either String String)
psh cmd =
  bracketOnError
  (debug cmd >> (createProcess $ (shell cmd) { std_out = CreatePipe
                               , std_err = CreatePipe
                               , create_group = True }))
  (\(_, Just hout, Just herr, ph) -> do
      interruptProcessGroupOf ph<commit_msg>get email from emailFrom; fix single-repo update<commit_after>{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

module Main where

import qualified Data.Yaml.Config as YConf
import System.Environment
import System.Directory
import System.Exit

import qualified Data.Text as T
import Network.Mail.Mime.SES
import qualified Data.Text.Encoding as DTE
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as LBS
import Network.HTTP.Conduit
import Control.Monad
import Data.Monoid
import Data.Maybe
import Data.String

import Data.Conduit
import System.Cmd
import Data.Time
import System.Locale (defaultTimeLocale)
import qualified Data.Time.Format as DTF

import System.Process
import System.Cmd
import System.IO
import System.Exit
import qualified Control.Exception as C
import Control.Exception
import Control.DeepSeq (rnf)
import Control.Concurrent


confPath = "/etc/debcd/debcd.yml"

main = do
  conf <- getConfig
  sender <- getSender conf

  update conf sender

update conf sender = do

  let upRepos = YConf.lookupDefault "update-repos" ("all"::String) conf

      updateCmd 
         = case upRepos of
             "all"  -> "apt-get update"
             "none" -> "echo Nothing to do"
             repo   -> "apt-get update -o Dir::Etc::sourcelist=\"sources.list.d/"++
                               repo++".list\" -o Dir::Etc::sourceparts=\"-\" "++
                               "-o APT::Get::List-Cleanup=\"0\""

  updateRes <- psh updateCmd
  case updateRes of
    Left err -> sender $ ["debcd: error updating APT", 
                          "\nError:\n ", err]
    Right _ -> do
        upgradesAvailable <- fmap ((/=) ExitSuccess) 
                                  $ system "apt-get -u upgrade --assume-no"                               
        when upgradesAvailable $ upgrade sender

upgrade sender = do

 selections <- createFreezeList
 putStrLn "upgrading.."
 upgRes <- system "DEBIAN_FRONTEND=noninteractive apt-get upgrade -y"
 putStrLn "..done upgrading"
 case upgRes of
   ExitFailure err -> sender $ ["debcd: error upgrading packages", 
                          "\nError:\n ", show err]
   ExitSuccess -> do

       -- run tests
       testsOK <- runTests sender

       -- roll back on failure
       when (not testsOK) $ rollback selections

       return ()

-- these two based on http://www.debian-administration.org/article/669/

runTests sender = do
  files <- getDirectoryContents "/etc/debcd/tests.d/"
  testRess <-  forM files $ \file -> do
    p <- getPermissions $ "/etc/debcd/tests.d/"++file
    if not $ executable p
       then return Nothing
       else do debug $ "running test "++ file
               res <- psh $ "/etc/debcd/tests.d/"++file
               case res of 
                 Right _ -> return Nothing
                 Left err -> return $ Just $ "Test: "++file++"\nOutput:\n"++ 
                                               (unlines $ map ("  "++) $ lines err)
  if all isNothing testRess
     then return True
     else do sender ("debcd: Test failure":catMaybes testRess)
             return False

createFreezeList :: IO String
createFreezeList = do
 now <- getCurrentTime
 let nowS =  DTF.formatTime defaultTimeLocale "%Y%m%d%H%M" now
 system "mkdir -p /var/debcd"
 system $ "aptitude -q -F \"%?p=%?V %M\" --disable-columns search \\~i > /var/debcd/"
          ++nowS
 return nowS

rollback :: String -> IO ()
rollback list = void $ do
  system $ "aptitude -q -R --schedule-only install $(awk < /var/debcd/"++
           list++" '{print $1}')"
  system $ "aptitude -q -R --schedule-only markauto $(awk < /var/debcd/"++
           list++" '$2==\"A\" {split($1,A,\"=\");print A[1]}')"
  system $ "aptitude -y -o Dpkg::Options::=\"--force-confdef\" install"

getConfig :: IO YConf.Config
getConfig = do
 allConfig <- YConf.load confPath
 args <- getArgs
 let envNm = case (args, YConf.keys allConfig) of
            (env:_, _) -> T.pack env
            ([], []) -> error $ "debcd: unable to determine a configuration "++
                                "environment from "++confPath
            ([] , env:_) -> env
 case YConf.subconfig envNm allConfig of
           Nothing -> fail $ "Cannot find configuration environment "++
                             T.unpack envNm++" in "++confPath
           Just c -> return c

getSender :: YConf.Config -> IO ([String] -> IO ())
getSender conf = 
  let mses = do emailTo <- YConf.lookup "emailTo" conf
                emailFrom <- YConf.lookup "emailFrom" conf
                access <-  YConf.lookup "aws_access" conf
                secret <-  YConf.lookup "aws_secret" conf
                return $ SES
                   { sesFrom = S8.pack $ emailFrom
                   , sesTo = [DTE.encodeUtf8 emailTo]
                   , sesAccessKey = S8.pack $ access
                   , sesSecretKey = S8.pack $ secret
                   }
  in case mses of
       Nothing -> return $ putStrLn . unlines 
       Just ses -> do man <- newManager conduitManagerSettings
                      return $  \ss -> do
                          runResourceT . sendMailSES man ses . fromString . unlines $ ss
                          putStrLn $ unlines ss
                          putStrLn "(sent email)"             

psh :: String -> IO (Either String String)
psh cmd =
  bracketOnError
  (debug cmd >> (createProcess $ (shell cmd) { std_out = CreatePipe
                               , std_err = CreatePipe
                               , create_group = True }))
  (\(_, Just hout, Just herr, ph) -> do
      interruptProcessGroupOf ph
{'fraction_non_alphanumeric': 0.11317354478284375, 'fraction_numerical': 0.002522977112993332, 'mean_word_length': 1.9354668077228248, 'pattern_counts': {'":': 4, '<': 45, '<?xml version=': 0, '>': 55, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2024036', 'n_tokens_mistral': 3307, 'n_tokens_neox': 3134, 'n_words': 976}