data-visualization.Rmd

---
title: "Phishing: jak się nie dać \"złapać\""
author: "By Vitalii Morskyi & Julia Makarska"
output:
  pdf_document: default
  html_notebook: default
---

Zjawisko Phishingu zachodzi już od wielu lat. Jednak między innymi ostatni rok pokazał nam jak ważne jest bezpieczeństwo w internecie. Od roku świat się zatrzymał i przeniósł wszystko do Internetu. Z uwagi na ten fakt podjęcie tematu Phishingu uznaliśmy za bardzo na miejscu. Chcemy pokazać jak łatwo można dać się okraść. Przedstawiony przez nas projekt obejmuje tylko niewielki kawałek tej metody oszustwa, jednak uznaliśmy, że temat jest ciekawy.
Phishing jest to atak oparty na wiadomościach e-mail lub SMS. Przestępcy internetowi próbują Cię oszukać i wymusić na Tobie działania zgodne z ich oczekiwaniami.

---

```{r message=FALSE, warning=FALSE}
library("stringi")
library("stringr")
library("lattice")
library("ggplot2")
library("ggExtra")
library("hrbrthemes")
library("rgl")
library("GGally")

source("modules/split-url.r")
source("modules/url-ambiguity.r")
source("modules/url-lengths.r")
source("modules/url-special-symbol-count.r")

# Mendeley Data : Dataset of Malicious and Benign Webpages
dfm <- read.csv("data/Webpages_Classification_10k.csv",  row.names = "X") 

# Aalto University : PhishStorm - phishing / legitimate URL dataset
dfp <- read.csv("data/PhishStorm_urlset_96k.csv") 
```

```{r}
head(dfm, n = 1L)
head(dfp)
```


# Wstępne przygotowanie danych.

---

Przeprowadzono wstępną edycję datasetów, ponieważ na pierwszy rzut widać, że:
 - wejściowe ramki danych zawierają zbędne kolumny, których nie uwzględniamy w naszej analizie
 - mają różne nazwy najważniejszych dla naszej analizy kolumn - *domain* i *url*
 - otagowanie domen w zbiorze danych *"PhishTank"* nie jest zbyt zrozumiałe
 
```{r}
dfm[c("content", "url_len", "ip_add")] <- NULL
head(dfm)
```

W ramce danych `dfm` pozostawiamy następujące kolumny:
 - url - Adres URL strony internetowej.
 - geo_loc - Lokalizacja geogreficzna, w której jest hostowana strona internetowa.
 - tld - Domena najwyższego poziomu strony internetowej.
 - who_is - Czy informacje o domenie WHO IS są konkurencyjne, czy nie.
 - https - Czy witryna korzysta z https czy http. 
 - js_len - Długość kodu JavaScript na stronie.
 - js_obf_len - Długość zaciemnionego kodu JavaScript.
 - label - Etykieta klasy dla niegroźnej lub złośliwej strony internetowej.

```{r}
colnames(dfp)[1] <- "url"
dfp[c("card_rem", "ratio_Rrem", "ratio_Arem", 
      "jaccard_RR", "jaccard_RA", "jaccard_AR", 
      "jaccard_AA", "jaccard_ARrd", "jaccard_ARrem")] <- NULL
dfp$label <- factor(dfp$label)
dfp$mld_res <- factor(dfp$mld_res)
dfp$mld.ps_res <- factor(dfp$mld.ps_res)
levels(dfp$label) <- c("good", "bad")
levels(dfp$mld_res) <- c("no", "yes")
levels(dfp$mld.ps_res) <- c("no", "yes")
head(dfp)
```

W ramce danych `dfp` pozostawiamy następujące kolumny:
 - url - Adres URL strony internetowej.
 - ranking - Ranking mld.ps według rankingu witryny [Alexa](http://www.alexa.com/).
 - mld_res - Czy są wyniki wyszukiwania czy nie dla mld w adresie URL.
 - mld.ps_res - Czy są wyniki wyszukiwania czy nie dla mld.ps w adresie URL.
 - label - Etykieta klasy dla niegroźnej lub złośliwej strony internetowej.


# Obliczanie badanych cech.

---

Najpierw dzielimy link na następujące części: |  *`split_url()`* oraz *`clean_split_url()`*
 - protocol *(schemat)*
 - domain name *(nazwa serwera)*
 - path *(ścieżka do pliku)* 
 - query *(zapytanie)*
 - fragment *(fragment)*
 


```{r}
split_res <- clean_split_url(dfp$url)
split_res[20:29,]
```


---

Bierzemy pod uwage następujące cechy każdej z wymienionych powyżej części:
 - długość  |  *`url_lengths()`*
 - następujące stosunki długości:  |  *`url_lengths()`*
    - Domain Name divided by URL (Nazwa domeny w stosunku do adresu URL)
    - Path divided by URL (Ścieżka w stosunku do adresu URL)
    - Argument divided by URL (Argument w stosunku do adresu URL)
    - Path divided by Domain Name (Ścieżka podzielona według nazwy domeny)
    - Argument divided by Domain Name (Argument w stosunku do nazwy domeny)
    - Argument divided by Path (Argument w stosunku do ścieżki)
 - ciąg znaków postaci `litera-cyfra-litera`  |  *`letter_digit_letter()`*
 - ciąg znaków postaci `cyfra-litera-cyfra`  |  *`digit_letter_digit()`*
 - połączenie dwóch poprzednich ciągów  |  *`combined_url_ambiguity()`*
 - liczba liter  |  *`lett_dig_symb_count()`*
 - liczba cyfr  |  *`lett_dig_symb_count()`*
 - liczba znaków interpunkcyjnych  |  *`lett_dig_symb_count()`*

```{r}
lengths_res <- url_lengths(split_res)
lengths_res[20:29,]

ldl_res <- letter_digit_letter(split_res)
dld_res <- digit_letter_digit(split_res)
xyx_res <- combined_url_ambiguity(split_res)
cbind(ldl_res, dld_res, xyx_res)[20:29,]

ldsc_res <- lett_dig_symb_count(split_res)
ldsc_res[20:29,]
```

---

Powtarzamy analogicznie, obliczenia dla drugiego zbioru danych, ale tym razem już nie będziemy wyświetlać wyników każdego obliczenia.


```{r}
split_res_2 <- clean_split_url(dfm$url)
lengths_res_2 <- url_lengths(split_res_2)
ldl_res_2 <- letter_digit_letter(split_res_2)
dld_res_2 <- digit_letter_digit(split_res_2)
xyx_res_2 <- combined_url_ambiguity(split_res_2)
ldsc_res_2 <- lett_dig_symb_count(split_res_2)
```

# Zebranie wszystkich parametrów do jednej ramki danych.

---

Najpierw tworzymy jedną macierz z wynikami wszystkich obliczeń, którą potem konwertujemy w ramkę danych.

```{r}
params_df <- as.data.frame(cbind(
    lengths_res,
    ldl_res,
    dld_res,
    xyx_res,
    ldsc_res
))
params_df_2 <- as.data.frame(cbind(
    lengths_res_2,
    ldl_res_2,
    dld_res_2,
    xyx_res_2,
    ldsc_res_2
))
dim(params_df)
```

---

Otrzymano dość dużą ramkę danych, więc przydałoby się ją troszkę zmniejszyć. Po przeanalizowaniu jej struktury  zauważono, że niektóre kolumny posiadają 0 poziomów, czyli nie przechowują żadnej informacji, więc można je usunąć. Zatem można połączyć wejściową ramkę danych z otrzymaną. Dokonano analogicznych działań dla obu zbioró danych.

---


```{r}
str(params_df)

params_df[, c("protocol", "protocol_l", "ldl_protocol", 
              "dld_protocol", "xyx_protocol", "lett_protocol", 
              "dig_protocol", "symb_protocol")] <- NULL

params_df_2[, c("protocol", "protocol_l", "ldl_protocol", 
                "dld_protocol", "xyx_protocol", "lett_protocol", 
                "dig_protocol", "symb_protocol")] <- NULL

fdfp <- cbind(dfp, params_df)
fdfm <- cbind(dfm, params_df_2)

cat("First DataFrame dimensions (dfdp): \n", dim(fdfp), 
    "\nSecond DataFrame dimensions (dfdm):\n", dim(fdfm), "\n")
```

\newpage

# Wizualizacja wyników analizy.

---

```{r}
fdfm[fdfm$label == "bad", "color"] <- '#6dd38c'
fdfm[fdfm$label == "good", "color"] <- '#f3aca7'

fdfp[fdfp$label == "bad", "color"] <- '#6dd38c'
fdfp[fdfp$label == "good", "color"] <- '#f3aca7'

# ggsave(
#   "images/plot_1.png",
#   plot = last_plot(),
#   device = "png",
#   path = NULL,
#   scale = 1.2,  
#   #  width = 300,
#   #  height = 300,
#   #  units = "mm",
#   dpi = 400,
#   bg = "transparent"
# )

data_distribution_df <- data.frame(counts = c(sum(fdfp$label == "good"), sum(fdfp$label == "bad")),
                                   labels = c("good", "bad"))
ggplot(data_distribution_df, aes(x = "", y = counts, fill = labels)) +
  geom_bar(stat = "identity", width = 1, color = "white") +
  coord_polar("y", start = 0) + 
  theme_void() + ggtitle("Porównanie bezpieczeństwa domen w zbiorze danych \"PhishStorm\".") +
  theme(plot.title = element_text(family = "", 
                                  face = 'bold', 
                                  colour = 'black', 
                                  size = 12)) + 
  labs(fill = "Etykieta", color = "Etykieta")
```

\newpage

```{r}
data_distribution_df2 <- data.frame(counts = c(sum(fdfm$label == "good"), sum(fdfm$label == "bad")),
                                    labels = c("good", "bad"))
ggplot(data_distribution_df2, aes(x = "", y = counts, fill = labels)) +
  geom_bar(stat = "identity", width = 1, color = "white") +
  coord_polar("y", start = 0) + 
  theme_void() + 
  ggtitle("Porównanie bezpieczeństwa domen w poprzednio przygotowanym\nzbiorze danych \"Mendeley Data\".") +
  theme(plot.title = element_text(family = "", 
                                  face = 'bold', 
                                  colour = 'black', 
                                  size = 12)) + 
  labs(fill = "Etykieta", color = "Etykieta")
```

\newpage

```{r}
ggplot(fdfp[fdfp$url_l < 500, ], aes(x = label, y = url_l, group = label, fill = label)) + 
  geom_violin() +
  ylab("Długość linku") + 
  xlab("Etykieta") + 
  ggtitle("Porównanie długości adresów URL.") +
  theme(plot.title = element_text(family = "", 
                                  face = 'bold', 
                                  colour = 'black', 
                                  size = 12)
#         panel.background = element_rect(fill = "#f0bc5e", colour = "black")
#         rect = element_rect(fill = "#d8d7c4") 
  ) + 
 scale_fill_manual(values = c("#6dd38c", "#f3aca7")) +
  labs(color = "Etykieta")
```

\newpage

```{r}
splom(~data.frame(xyx_host, lett_host, dig_host, symb_host), 
      data = fdfp[sample(nrow(fdfp), 1000),],
      pch = 1,
      main = "Rozkład symboli w hoscie adresu URL (host part of the URL).",
      groups = label,
#       xlab = c("A", "B", "C", "D"),
#       xlab = "", # czymś takim można usunąńć ten napis "Scatter Plot Matrix"
#       ylab = c("A", "B", "C", "D"),
      pscales = 0,
      auto.key = list(columns = 2),
      varnames = c("Ilość ciągów\npostaci XYX", "Ilość liter", 
                   "Ilość cyfr", "Liczba znaków\ninterpunkcyjnych")
      )
```

\newpage

```{r}
ggpairs(fdfp[fdfp$url_l < 500 & sample(nrow(fdfp), 1000), ], 
        aes(color = color,
            alpha = .5),
        columns = c("xyx_host", "lett_host", "dig_host", "symb_host"),
        columnLabels = c("Ilość ciągów\npostaci XYX", 
                         "Ilość liter", 
                         "Ilość cyfr",
                         "Liczba znaków\ninterpunkcyjnych")) +
  ggtitle("Rozkład symboli w hoście adresu URL.") +
  theme(plot.title = element_text(family = "", 
                                  face = 'bold', 
                                  colour = 'black', 
                                  size = 12)
#         panel.background = element_rect(fill = "#f0bc5e", colour = "black"),
#         rect = element_rect(fill = "#d8d7c4")
  ) + 
  labs(color = "Etykieta")
```

\newpage

```{r}
histogram(~ symb_url  | label  , 
          data = fdfp[sample(nrow(fdfp), 2000),],
          main = "Porównanie ilości znaków interpunkcyjnych\nw dobrych i złych domenach.",
          xlab = "Ilość symboli w adresie URL",
          ylab = "Procent całości",
          layout = c(1, 2),
          nint = 20,
          xlim = c(0, 50)
         )
```

\newpage

```{r}
ggplot(fdfp[fdfp$url_l < 500, ], aes(x = symb_url, fill = label)) + 
  geom_histogram(binwidth = 2, alpha = 0.6, position = 'identity') +
  ylab("Ilość wystąpień") + 
  xlab("Ilość symboli w adresie URL") + 
  ggtitle("Porównanie ilości znaków interpunkcyjnych\nw dobrych i złych domenach.") +
  theme(plot.title = element_text(family = "", 
                                  face = 'bold', 
                                  colour = 'black', 
                                  size = 12)
#         panel.background = element_rect(fill = "#f0bc5e", colour = "black"),
#         rect = element_rect(fill = "#d8d7c4")
  ) + 
  scale_fill_manual(values = c("#6dd38c", "#f3aca7")) +
  labs(fill = "Etykieta", color = "Etykieta")
```

\newpage

```{r}
p <- ggplot(fdfp[fdfp$url_l < 1000, ], aes(x = xyx_query, y = xyx_url, color = label)) +
    geom_point(alpha = .7, na.rm = TRUE) + 
    theme(legend.position = "left") +
    ylab("Letter-Digit-Letter lub Digit-Letter-Digit w całym adresie URL") + 
    xlab("Letter-Digit-Letter lub Digit-Letter-Digit w zapytaniu") + 
    ggtitle("Porównanie podejrzanych ciągów w adresach URL.") +
    theme(plot.title = element_text(family = "", 
                                    face = 'bold', 
                                    colour = 'black', 
                                    size = 12)) + 
    labs(color = "Etykieta")

ggMarginal(p, type = "histogram")
```

\newpage

```{r}
splom(~data.frame(host_l, path_l, query_l, fragment_l, xyx_host, xyx_path, xyx_query), 
      data = fdfp[sample(nrow(fdfp), 2000),],
      pch = 1,
      main = "Rozkład znaków w domenach.",
      groups = label,
      pscales = 0,
      auto.key = list(columns = 2),
      varnames = c("Długość\nhosta", "Długość\nścieżki", "Długość\nzapytania", 
                   "Długość\nfragmentu", "XYX\nhost", "XYX\nścieżka", 
                   "XYX\nzapytanie")
      )
```

\newpage


```{r}
ggplot(data = fdfp[fdfp$url_l < 200, ], aes(x = symb_url, group = label, fill = label)) +
  geom_density(adjust = 5, alpha = .4) +
  ylab("Gęstość") + 
  xlab("Ilość znaków interpunkcyjnych w linku") + 
  ggtitle("Gęstość ilości znaków interpunkcyjnych w linkach") + 
  theme(plot.title = element_text(family = "", 
                                  face = 'bold', 
                                  colour = 'black', 
                                  size = 12)
#         panel.background = element_rect(fill = "#f0bc5e", colour = "black"),
#         rect = element_rect(fill = "#d8d7c4")
  ) + 
  scale_fill_manual(values = c("#6dd38c", "#f3aca7")) +
  labs(fill = "Etykieta", color = "Etykieta")
```

\newpage

```{r}
ggplot(data = fdfm, aes(x = js_len, group = label, fill = label)) +
  geom_density(adjust = 1, alpha = .4) +
  ylab("Gęstość") +
  xlab("Długość kodu JavaScript") +
  ggtitle("Gęstość długości kodu JavaScript na stronach internetowych.") + 
  theme(plot.title = element_text(family = "", 
                                  face = 'bold', 
                                  colour = 'black', 
                                  size = 12)
#         panel.background = element_rect(fill = "#f0bc5e", colour = "black"),
#         rect = element_rect(fill = "#d8d7c4")
  ) + 
  scale_fill_manual(values = c("#f3aca7", "#6dd38c")) +
  labs(fill = "Etykieta", color = "Etykieta")
```

\newpage

```{r}
ggplot(data = fdfm, aes(x = js_len, y = js_obf_len, color = label) ) +
  geom_point() +
  ylab("Długość zaciemnionego kodu JavaScript.") + 
  xlab("Długość kodu JavaScript") + 
  ggtitle("Związek pomiędzy długością kodu JavaScript\na biezpiecznością domen")  + 
  theme(plot.title = element_text(family = "", 
                                  face = 'bold', 
                                  colour = 'black', 
                                  size = 12)
#         panel.background = element_rect(fill = "#f0bc5e", colour = "black"),
#         rect = element_rect(fill = "#d8d7c4")
  ) + 
  scale_fill_manual(values = c("#6dd38c", "#f3aca7")) +
  labs(fill = "Etykieta", color = "Etykieta")
```

# Wnioski

---

Przeprowadzając powyższą analizę wiele się nauczyliśmy. Zauważyliśmy jakie związki leksykalne występują w przypadku domen złych. Wiemy jakie "zamiany" występują najczęściej. Przyglądając się linkom nie zawsze da się to wszystko wyłapać od razu. Zatem najważniejszym, ale nie jedynym, wnioskiem płynącym z naszego projektu jest fakt, że trzeba uważać w jakie linki się wchodzi.
**Dostałeś/łaś podejrzanego maila? Nie otwieraj żadnych linków!**